w䩶PբԠ0 )i(Ԑ601ԩ Ԡ 9 9!! 9##`iLeH׍ ԍI h@$iskformatiertmit")"/-/.QVk6"c "ibosoft #/-093(/07eitere)nformationenbei#/-093(/04elpppppppBPppppppppA62 Hɝ( Ǭ0SP .TXT Mit diesen Funktionen koennen sie alle Funktionen einer Speedy 1050 unter Pascal benutzen. Die mit eine}m "-" versehenen Funk- tionen laufen auch mit einer Happy oder einem US Doubler. Die mit einem "+" versehenen Funk- t}ionen arbeiten auch mit jeder anderen Double Density Floppy. Die mit einem "*" arbeiten mit jeder beliebigen Floppy. } Alle Funktionen geben den SIO Fehler Status zurueck. DISKCONT.EDISPLAY .EJMPTAB .EMAP .EPIA .EZEROPAGE.E } Diese Files sind fuer den erfahrenen Programmierer der eigene Progamme im Ram seiner Speedy installieren will. ADDCOMM } .F Addiert ein Kommando zur Kommando- tabelle der Speedy.AFORMAT .F Automatisches Formatieren.CLRDISK .F Reformati }eren (unbrauchbar machen) einer Disk.CLRTRACK.F Reformatieren (unbrauchbar machen) eines Tracks.FORMAT .F * Normal }es Formatieren.GETCONFI.F + Lade kompletten Percom Block.GETSIO .F Hole US-SIO aus der Speedy.JUMP .F Springt Pr }ogramm in der Speedy an.JUMPQUIT.F Quitiere und springe Programm in der Speedy anMFORMAT .F * Medium Density Format. }PUTSEC .F * Schreibe Sector ohne Verify.RAMTEST .F Ramtest der Speedy.RCONFIG .F + Lese verkuerzen Percom Block.RDT}RACK .F Lese kompletten Track.READSEC .F * Lese Sector.ROMTEST .F Speedy Romtest.SETCONFI.F Schreibe kompletten Pe}rcom Bock.SETDRIVE.F Setze Speedy Drive Status.SETSLOW .F Setze Speedy Slow Status.SIOLEN .F Lade Laenge der US-SIO} der Speedy.SIOSPEED.F - Lade US ByteSPEEDTST.F Laufwerksgeschwindigkeit.STATUS .F * Lese Laufwerksstatus.WCONFIG }.F + Schreibe verkuerzten Percom Block.WRITEBUF.F TrackWRITESEC.F * Schreibe Sector.WRTRACK .F Schreibe kompletten} Track.SPEEDY .H Jedes Programm, dass die Disk Funk- tionen benutzt muss diese File nach "program" includen.INITUS }.P Laed die US Routine aus der Speedy; versucht dann auf allen Floppys mit Ultra Speed zu laden und zu Schreiben.INS}TPROG.P Installiert ein Programm im Ram der Speedy. Das angegebene File muss ein Standart .COM File sein wie es von f}ast jedem Assember erzeugt wird.SPEEDY .T Typendeclarationen fuer Sectortypen.le sein wie es von fast jedem AssemberU;**************************************;* *;* Speedy 1050 Kyan Assembler Libery *;* } *;* Disk Controller *;* *;* (c) }1987 by Martin Krischik *;* *;**************************************; lst }off;dccom equ $0400 ;Command Registerdcstat equ $0400 ;Status Registerdctrack equ $0401 ;Track Registerdcsector eq}u $0402 ;Sector Registerdcdat equ $0403 ;Daten Regiser; lst on;;**************************************;* } End of diskcont.e *;**************************************on;;**************************************;* J;;**************************************;* *;* Speedy 1050 Kyan Assembler Libery *;* } *;* Display Buzzer Adressen *;* *;* (c)} 1987 by Martin Krischik *;* *;**************************************; ls}t off;disp1 equ $4000disp10 equ $4001density equ $4002buzzer equ $4003; lst on;;******************** }******************;* End of display.e *;**************************************;;;********************e;;**************************************;* *;* Speedy 1050 Kyan Assembler Libery *;* "} *;* Speedy Einsprungadressen *;* *;* (c #}) 1987 by Martin Krischik *;* *;**************************************; lst $} off;reset equ $ff00 ;Kaltstartreset2 equ $ff03 ;Warmstartbereit equ $ff06 ;Bereitschafsroutinemoton equ $ff09 ;Mo %}tor Einschaltentstmon equ $ff0c ;Mot ein w. Klappe zumotoff equ $ff0f ;Motor Ausschaltensdelay equ $ff12 ;Motor Timer s &}etzensdrddp equ $ff15 ;Density Anzeigenxwait equ $ff18 ;Warte Kurzx2wait equ $ff1b ;Warte Langtrack0 equ $ff1e ;Kopf '} Track 0tradja equ $ff21 ;Pos. Kopf Show Tracktradj equ $ff24 ;bei Wechsel s.o.trvr equ $ff27 ;Kopf 1 Stepconres e (}qu $ff2a ;Stop Controllerconre2 equ $ff2d ;2* Stop Controllerwready equ $ff30 ;Auf Controller Waitrd128b equ $ff33 ;Com )}p.->exbuf 128 B.rd256b equ $ff36 ;Comp.->exbuf 265 B.rdbts equ $ff39 ;c.->adr(x|y) accu B.rdsfol equ $ff3c ;Sec.folge *}Lesen waitrdsfo1 equ $ff3f ;Sec.folge Lesenrdtra equ $ff42 ;Read Trackrdtrav equ $ff45 ;Read Verify Tracktstwr equ +}$ff48 ;Write Sectorststdat equ $ff4b ;Write Mark Sectorssd128b equ $ff4e ;exbuf->Comp. 128 B.sd256b equ $ff51 ;exbuf->C ,}omp. 256 B.sdbts equ $ff54 ;adr(x|y)->c. accu B.send41 equ $ff57 ;'A' Sendensend43 equ $ff5a ;'C' Sendensend45 equ $ -}ff5d ;'E' Sendensend4e equ $ff60 ;'N' Sendenrdsect equ $ff63 ;Read aktuellen Sec.rdsec1 equ $ff66 ;Read bezeich. Sec.w .}rsect equ $ff69 ;Write aktuellen Sec.wrsec1 equ $ff6c ;Write bezeich. Sec.tstwrp equ $ff6f ;Test Write Protectversec e /}qu $ff72 ;Verify Akuel. Sec.verse1 equ $ff75 ;Verify bezeich. Sec.stell equ $ff78 ;COM Status Errorquitt equ $ff7b ;Q 0}uittung COM Statusrdhead equ $ff7e ;Read Header Timerrdhd1 equ $ff81 ;Read Headerrdhdsp equ $ff84 ;Pos Kopf Read Heade 1}rcalctr equ $ff87 ;Tarck|Sec. errechnensetbuf equ $ff8a ;Buffer aktuel. Sec. setbu2 equ $ff8d ;Buffer bezeich. Sec.sex 2}buf equ $ff90 ;Set Ext. Buffer Adr.setrwl equ $ff93 ;Set Buffer Lencopslt equ $ff96 ;Copy Sec. Listbell1 equ $ff99 ;1 3} mal Buzzerclrdsp equ $ff9c ;Display Ausschaltentraanz equ $ff9f ;Track # Anzeigendezout equ $ffa2 ;Accu Dez. Anzeigen 4}hexout equ $ffa5 ;Accu Hex Anzeigendendsp equ $ffa8 ;Density Anzeigensettim equ $ffab ;Set Timerclrtra equ $ffae ;Refo 5}rmat Trackcrldsk equ $ffb1 ;Reformat Diskramtst equ $ffb4 ;Ram Testromtst equ $ffb7 ;Rom Restspeedt equ $ffba ;speed 6}Test; lst on;;**************************************;* End of jmptab.e *;******************** 7}******************;;;**************************************;* End of jmptab.e *;******************** ;;**************************************;* *;* Speedy 1050 Kyan Assembler Libery *;* 9} *;* Memory Map *;* *;* (c:}) 1987 by Martin Krischik *;* *;**************************************; ls;}t off;userprog equ $8000;8bff ;Frei fuer Userdatbuf equ $8c00;9dff ;Track Bufferexbuf equ $9e00;9eff ;Extended Buffe<}rcomtbl equ $9f00;9f7f ;Commando Tabelletstco2v equ $9f80;9f81 ;Test Comando Adressemottimv equ $9f81;9f82 ;Motor Time=}r Adressereset3 equ $9f83;9fff ;User Reset Routiene; lst on;;**************************************;* >} End of map.e *;**************************************;;;**************************************;* H;;**************************************;* *;* Speedy 1050 Kyan Assembler Libery *;* @} *;* 6532 PIA *;* *;* (cA}) 1987 by Martin Krischik *;* *;**************************************; lsB}t off;;Port Adressen;pad equ $0280 ;Port A Data Registerpadd equ $0281 ;Port A Data Direction Registerpbd C} equ $0282 ;Port B Data Registerpbdd equ $0283 ;Port B Data Direction Register;;Timer Start Adressen (Schreiben);cntD}a equ $0294 ;Set Timer, Disable Timer IRQ, Teilungsfaktor 1cntb equ $0295 ;Set Timer, Disable Timer IRQ, TeilungsE}faktor 8cntc equ $0296 ;Set Timer, Disable Timer IRQ, Teilungsfaktor 64cntd equ $0297 ;Set Timer, Disable TimeF}r IRQ, Teilungsfaktor 1024cnte equ $029c ;Set Timer, Enable Timer IRQ, Teilungsfaktor 1cntf equ $029d ;Set TimerG}, Enable Timer IRQ, Teilungsfaktor 8cntg equ $029e ;Set Timer, Enable Timer IRQ, Teilungsfaktor 64cnth equ $02H}9f ;Set Timer, Enable Timer IRQ, Teilungsfaktor 1024rdtdis equ $0294 ;Read Timer, Disable Timer IRQrdten equ $029c ;ReI}ad Timer, Enable Timer IRQ;;Flag Register, Flankendetektor;rdflag equ $0295 ;Read Flag Registeredeta equ $0284 ;Hi J}Lo Flanke, Disable PA7 IRQedetb equ $0285 ;Lo Hi Flanke, Disable PA7 IRQedetc equ $0286 ;Hi Lo Flanke, Enable PA7 IRQK}edetd equ $0287 ;Lo Hi Flanke, Enable PA7 IRQ; ;Flag Register Bits:;;Bit 7 Timer Flag;Bit 6 PA7 Flag; lst L}on;;**************************************;* End of pia.e *;**************************************};;**************************************;* *;* Speedy 1050 Kyan Assember Libery *;* N} *;* Zero Page Adressen *;* *;* (cO}) 1987 by Martin Krischik *;* *;**************************************; lsP}t off;merk1 equ $00 ;Merker 1merk2 equ $01 ;Merker 2merk3 equ $02 ;Merker 3dlyt1 equ $03 ;Timer Q}Lo Motordlyt2 equ $04 ;Timer Hi Motorldsw equ $05 ;Last Dumm-Switchwrken equ $06 ;Anzahl Write sec.exsR}ext equ $07 ;Sec.# Ex. Buff.dumken equ $08 ;Dumm Statusforken equ $09 ;Densityforke2 equ $0a ;Density S}Formatlwrtra equ $0b ;Track # Writetrack equ $0c ;Track #sector equ $0e ;Sector #const equ $0f ;ConT}troler Statusdrstat equ $10 ;Drive Statuscomst equ $11 ;Command Statusretry equ $12 ;Retry's Read/WriterU}wlen equ $13 ;I/O Laengeseclen equ $14 ;Sector Laengeusken equ $15 ;US Kennungdlytim equ $16 ;Motor V}on Timestptim equ $17 ;Step Mot. Timecompos equ $18 ;Last Command ind equ $19;1a ;Ind.Vec.Dat.buf.chksum W} equ $1b ;Checksum IOrddatk equ $1c ;Input ?klappe equ $1d ;Letzte Kappen Pos.secanz equ $1f ;Sec. AnzahX}l Sollsecan1 equ $1f ;Sec. Anzahl Istseclst equ $20;3f ;Sector Listestalst equ $40;5f ;Sector Statusstppos equY} $60 ;Bit Pos. Step Mot.dspctr equ $61 ;Disp. Drive Stat.blocks equ $62 ;Datenblocks IOioind equ $63 ;IZ}O Routienen #;; Comando vom Computer gesendet;Driveno equ $80 ;Drive #Command equ $81 ;Commandoaux1 equ $82[} ;Aux 1aux2 equ $83 ;Aux 2;; Rest der Zero Page;freezero equ $90;cf ;Frei fuer UserStack equ $d0;ff ;Stack\}; lst on;;**************************************;* End of zeropage.e *;***********************]}***************;;;**************************************;* End of zeropage.e *;***********************function addcommand(Drive:integer; command:char; address:integer):integer; begin addcommand:=0;#a stx _t stv_}ar 9,buffer ;Commando Name stwvar 7,buffer+1 ;Commando Adresse lda #'1 ;ID:= Disk sta ddevic st`}var 10,dunit ;Disk Drive # lda #'A ;Add Command sta dcomnd lda #$80 ;Daten Output sta a}dstats ldw dbuf,buffer ;dbuf := buffer lda #7 ;Timeout := 7 sec sta dtim ldw dbyt,3 ;buflb}en := 3 byte jsr ussiov ldvar 5,dstats ;Fehler Status ldx _t# end; sta dtim ldw dbyt,3 ;buflWfunction autoformat(drive:integer):integer; begin autoformat:=0;#a stx _t lda #'1 ;ID:= Disk sta d}ddevic stvar 7,dunit lda #$20 ;Format disk sta dcomnd lda #0 ;Kein Daten IO sta dstats e}lda #7 ;7 sec Timeout sta dtim jsr ussiov ldvar 5,dstats ;Fehler Status ldx _t# end;dstats rfunction cleardisk(drive:integer):integer; begin cleardisk:=0;#a stx _t lda #'1 ;ID:= Disk sta d$g}devic stvar 7,dunit lda #'M ;Jump with Quit sta dcomnd lda #0 ;Kein Daten IO sta dstats$h} lda #7 ;7 sec Timeout sta dtim ldw daux1,$ffb1 ;Adresse Clrtra jsr ussiov ldvar 5,dstats l$i}dx _t# end; ;7 sec Timeout sta dtim ldw daux1,$ffb1 ;Adresse Clrtra jsr ussiov ldvar 5,dstats l$function cleartrack(drive:integer):integer; begin cleartrack:=0;#a stx _t lda #'1 ;ID:= Disk sta(k} ddevic stvar 7,dunit lda #'M ;Jump with Quit sta dcomnd lda #0 ;Kein Daten IO sta dstat(l}s lda #7 ;7 sec Timeout sta dtim ldw daux1,$ffae ;Adresse Clrtra jsr ussiov ldvar 5,dstats (m} ldx _t# end; ;7 sec Timeout sta dtim ldw daux1,$ffae ;Adresse Clrtra jsr ussiov ldvar 5,dstats (function format(drive:integer):integer; begin format:=0;#a stx _t lda #'1 ;ID:= Disk sta ddevi,o}c stvar 7,dunit ;Disk # := drive lda #'! ;Format disk sta dcomnd lda #80 ;Daten Input,p} sta dstats ldw dbuf,buffer ;Buffer lda #$E0 ;224 sec Timeout sta dtim movbps ;Buff,q}erlaenge jsr ussiov ldvar 5,dstats ;Fehler status ldx _t# end;t sta dtim movbps ;Buff,Sfunction getconfig(Drive:integer; var Track,Step,sector_per_track,head,density, byte_per_sector,online,rat0s}e,reserv:integer):integer; begin getconfig:=0;#a stx _t lda #'1 ;ID:= Disk sta ddevic stva0t}r 25,dunit ;Drive # lda #'N ;Get Config sta dcomnd lda #$40 ;Daten empfangen sta dstat0u}s ldw dbuf,buffer lda #7 ;Timeout := 7 sec sta dtim ldw dbyt,12 ;buflen := 12 jsr siov0v} ldvar 5,dstats ;Fehler Status bmi _gc ;Config Fehler ldind 23,buffer ;Track iny lda #0 0w} sta (_r1),y ldind 21,buffer+1 ;Step Rate iny lda #0 sta (_r1),y ldind 19,buffer+2 ;Sector per Track 0x} iny lda buffer+3 sta (_r1),y ldind 17,buffer+3 ;Head iny lda #0 sta (_r1),y ldind 15,buffer+5 ;D0y}ensity iny lda #0 sta (_r1),y ldind 13,buffer+6 ;Byte per Sector iny lda buffer+7 sta (_r1),y 0z} ldind 11,buffer+8 ;On Line iny lda #0 sta (_r1),y ldind 9,buffer+9 ;Baut Rate iny lda #0 sta (_0{}r1),y ldind 7,buffer+10 ;Reserv iny lda buffer+11 sta (_r1),y lda dunit asl tay lda buffer+60|} ;Interne Werte sta b_p_s,x+1 ;neu setzen lda buffer+7 sta b_p_s,x lda buffer+3 sta s_p_t,x_gc0}} ldx _t# end;rte sta b_p_s,x+1 ;neu setzen lda buffer+7 sta b_p_s,x lda buffer+3 sta s_p_t,x_gc0function getsio(drive :integer; var sio:siotyp; siolen,address:integer):integer; begin getsio:=0;#a stx _t l4}da #'1 ;Disk sta ddevic stvar 13,dunit ;Disk Drive # lda #'i ;Lese USSIO sta dcomnd lda #$44}0 ;Daten Input sta dstats stwvar 11,dbuf ;Physik. adresse lda #7 ;7 sec Timeout sta dtim st4}wvar 9,dbyt ;SIO laenge stwvar 7,daux1 ;Logische adresse jsr ussiov ldvar 5,dstats ;Error Status ldx _t#4} end;byt ;SIO laenge stwvar 7,daux1 ;Logische adresse jsr ussiov ldvar 5,dstats ;Error Status ldx _t#4function jump(drive,address,timeout:integer):integer; begin jump:=0;#a stx _t lda #'1 ;ID:= Disk 8}sta ddevic stvar 11,dunit lda #'L ;Jump no Quit sta dcomnd lda #0 ;Kein Daten IO sta dstat8}s stvar 7,dtim ;Timout unbekannt stwvar 9,daux1 ;Startadresse jsr siov ldvar 5,dstats ;Fehler Status 8}ldx _t# end;im ;Timout unbekannt stwvar 9,daux1 ;Startadresse jsr siov ldvar 5,dstats ;Fehler Status 8function jumpquit(drive,address:integer):integer; begin jumpquit:=0;#a stx _t lda #'1 ;ID:= Disk <}sta ddevic stvar 9,dunit ;Disk Drive # lda #'M ;Jump with Quit sta dcomnd lda #0 ;Kein Daten <}IO sta dstats lda #7 ;7 sec Timeout sta dtim stwvar 7,daux1 ;Startadresse jsr ussiov ldvar 5<},dstats ;Fehler Status ldx _t# end;Timeout sta dtim stwvar 7,daux1 ;Startadresse jsr ussiov ldvar 5<,function mediumformat(drive:integer):integer; begin mediumformat:=0;#a stx _t lda #'1 ;ID:= Disk @} sta ddevic stvar 7,dunit lda #'" ;Format disk medium sta dcomnd lda #$80 ;Daten Input sta@} dstats ldw dbuf,buffer lda #$E0 ;224 sec Timeout sta dtim ldw dbyt,128 jsr ussiov ldvar 5,ds@}tats ;Fehler Status ldx _t# end; ;224 sec Timeout sta dtim ldw dbyt,128 jsr ussiov ldvar 5,ds@*function putsector(drive,sector:integer; var buffer:sectyp):integer; begin putsector:=0;#a stx _t lda #'D}1 ;Disk sta ddevic stvar 11,dunit ;Disk # := drive lda #'P ;Put Sector sta dcomndD} lda #$80 ;Daten Output sta dstats stwvar 7,dbuf ;Buffer lda #7 ;7 sec Timeout D} sta dtim movbps ;Sector laenge stwvar 9,dsec ;Sector # lda dsec+1 ;sector 1 bis 3D} bne _put ;Boot Sectoren lda dsec ;128 Bytes cmp #4 bcs _put ldw dbyt,128_put D} jsr ussiov ldvar 5,dstats ;Error Status ldx _t# end; cmp #4 bcs _put ldw dbyt,128_put DIfunction ramtest(drive:integer; var address:integer):integer; begin ramtest:=0;#a stx _t lda #'1 ;IDH}:= Disk sta ddevic stvar 9,dunit lda #'L ;Jump no Quit sta dcomnd lda #$40 ;Daten Input H} sta dstats stwvar 7,dbuf ;Adress rueckgabe lda #7 ;7 sec Timeout sta dtim ldw dbyt,2 ;2 bytH}e rueckgabe ldw daux1,$ffb4 ;Ramtest Adresse jsr ussiov ldvar 5,dstats ldx _t# end;w dbyt,2 ;2 bytHifunction readconfig(Drive:integer;var sector_per_track, byte_per_sector:integer):integer; begin reL}adconfig:=0;#a stx _t lda #'1 ;ID:= Disk sta ddevic stvar 11,dunit ;Drive # lda #'N L} ;Get Config sta dcomnd lda #$40 ;Daten empfangen sta dstats ldw dbuf,buffer lda #7 ;TL}imeout := 7 sec sta dtim ldw dbyt,12 ;buflen := 12 jsr ussiov ldvar 5,dstats ;Fehler Status bmi _L}rc ;Config Fehler ldind 9,buffer+3 ;Sector per Track iny lda buffer+2 sta (_r1),y ldind 7,buffeL}r+7 ;Byte per Sector iny lda buffer+6 sta (_r1),y lda dunit asl tax lda buffer+6 ;Interne WeL}rte sta b_p_s+1,x ;neu setzen lda buffer+7 sta b_p_s,x lda buffer+3 sta s_p_t,x_rc ldx _t# end;eL|function Readtrack(drive,sector:integer; var buffer:track):integer; begin Readtrack:=0;#a stx _P}t lda #'1 ;Disk sta ddevic stvar 11,dunit ;Disk # := drive lda #$62 ;Read Track P} sta dcomnd lda #$40 ;Daten Input sta dstats stwvar 7,dbuf ;Buffer lda #7 ;7 sec TP}imeout sta dtim ldw dbyt,$900 ;SD Track lda dunit asl tax lda s_p_t,x cmp #26 P} bne _nomd lda #$0d ;MD Track Hi Byte sta dbyt+1 bne _nodd_nomd lda b_p_s,x+1 beq _nodd P} lda #$12 ;DD Track Hi Byte sta dbyt+1_nodd stwvar 9,dsec ;Startsector jsr ussiov ldvar 5P},dstats ;Error Status ldx _t# end;a dbyt+1_nodd stwvar 9,dsec ;Startsector jsr ussiov ldvar 5P/function readsector(drive,sector:integer; var buffer:sectyp):integer; begin readsector:=0;#a stx _t lda T}#'1 ;Disk sta ddevic stvar 11,dunit ;Disk # := drive lda #'R ;Lese Sector sta dcoT}mnd lda #$40 ;Daten Input sta dstats stwvar 7,dbuf ;Buffer lda #7 ;7 sec TimeoutT} sta dtim movbps ;Sector laenge stwvar 9,dsec ;Sector # lda dsec+1 ;sector 1 bis T}3 bne _read ;Boot Sectoren lda dsec ;128 Bytes cmp #4 bcs _read ldw dbyt,128_rT}ead jsr ussiov ldvar 5,dstats ;Error Status ldx _t# end; cmp #4 bcs _read ldw dbyt,128_rTKfunction romtest(drive:integer):integer; begin romtest:=0;#a stx _t lda #'1 ;ID:= Disk sta ddeviX}c stvar 7,dunit lda #'L ;Jump no Quit sta dcomnd lda #0 ;Kein Daten IO sta dstats ldX}a #7 ;7 sec Timeout sta dtim ldw daux1,$ffb7 ;Einsprung Romtest jsr ussiov ldvar 5,dstats ldx X}_t# end; ;7 sec Timeout sta dtim ldw daux1,$ffb7 ;Einsprung Romtest jsr ussiov ldvar 5,dstats ldx X function setconfig(Drive,Track,Step,sector_per_track,head,density, byte_per_sector,online,rate,reserv:inte\}ger):integer; begin setconfig:=0;#a stx _t stvar 23,buffer ;Tracks stvar 21,buffer+1 ;Step Rate st\}var 20,buffer+2 ;Sec per Track Hi stvar 19,buffer+3 ;Sec per Track Lo stvar 17,buffer+4 ;Heads stvar 15,buffer+5 \};Density stvar 14,buffer+6 ;Byte per Sec Hi stvar 13,buffer+7 ;Byte per Sec Lo stvar 11,buffer+8 ;Online stva\}r 9,buffer+9 ;Baut Rate stvar 8,buffer+10 ;Reserv Hi stvar 7,buffer+11 ;Reserv Lo lda #'1 ;ID:= Disk\} sta ddevic stvar 25,dunit ;Drive # lda #'O ;Set Config sta dcomnd lda #$80 ;Daten \}Output sta dstats ldw dbuf,buffer ;dbuf := buffer lda #7 ;Timeout := 7 sec sta dtim ldw dbyt\},12 ;buflen := 12 jsr ussiov ldvar 5,dstats ;Fehler Status bmi _sc ;Config Fehler lda du\}nit ;Neu Setzen asl tax lda buffer+7 sta b_p_s+1,x lda buffer+6 sta b_p_s,x lda buffer+3\} sta s_p_t,x_sc ldx _t# end;ax lda buffer+7 sta b_p_s+1,x lda buffer+6 sta b_p_s,x lda buffer+3\%function setdrive(drive,status:integer):integer; begin setdrive:=0;#a stx _t lda #'1 ;ID:= Disk s`}ta ddevic stvar 9,dunit ;Disk Drive # lda #'D ;Set Drive Status sta dcomnd lda #0 ;Kein Date`}n IO sta dstats lda #7 ;7 sec Timeout sta dtim stvar 7,daux1 ;Drive/Display Status jsr ussiov `} ldvar 5,dstats ;Fehler Status ldx _t# end; sta dtim stvar 7,daux1 ;Drive/Display Status jsr ussiov `6function setslow(drive,status:integer):integer; begin setslow:=0;#a stx _t lda #'1 ;ID:= Disk stad} ddevic stvar 9,dunit ;Disk Drive # lda #'K ;Set Drive Slow/Fast sta dcomnd lda #0 ;Kein Dated}n IO sta dstats lda #7 ;7 sec Timeout sta dtim stvar 7,daux1 ;Slow/Fast Status jsr ussiov ld}dvar 5,dstats ;Fehler Status ldx _t# end;out sta dtim stvar 7,daux1 ;Slow/Fast Status jsr ussiov ld2function siolen(Drive :integer; var len:integer):integer; begin siolen:=0;#a stx _t lda #'1 ;ID:= Dh}isk sta ddevic stvar 9,dunit ;Disk Drive # lda #'h ;Get USSIO len sta dcomnd lda #$40 ;h}Daten empfangen sta dstats stwvar 7,dbuf ;daten -> len lda #7 ;Timeout := 7 sec sta dtim ldw dh}byt,2 ;buflen := 2 jsr ussiov ldvar 5,dstats ;Fehler Status ldx _t# end; 7 sec sta dtim ldw dh`function siospeet(drive:integer; var speet:integer):integer; begin siospeet:=0;#a stx _t lda #'1 ;ID:l}= Disk sta ddevic stvar 9,dunit ;Disk Drive # lda #'? ;Get SIO Speed sta dcomnd lda #$40 ;l}Daten empfangen sta dstats stwvar 7,dbuf ;daten -> len lda #7 ;Timeout := 7 sec sta dtim ldw dbyl}t,1 ;buflen := 1 Byte jsr ussiov ldvar 5,dstats ;Fehler Status ldx _t# end;ec sta dtim ldw dbylbfunction Speedtest(drive:integer; var Speed:real):integer; begin speedtest:=0;#a stx _t lda #'1 p};ID:= Disk sta ddevic stvar 9,dunit lda #'L ;Jump no Quit sta dcomnd lda #$40 ;Dp}aten Input sta dstats ldw dbuf,buffer ;Bufferadresse lda #7 ;7 sec Timeout sta dtim ldp}w dbyt,2 ;get 2 byte ldw daux1,$ffba ;Speedtest Adr. jsr ussiov ldvar 5,dstats ;Fehler Status p} bmi _st ;Fehler lda #0 ;2 Byte BCD -> Real sta buffer+2 ldx #4 ;4 bit Rechts p}_stl1 clc ;Vorzeichen +,+ lsr buffer ror buffer+1 ror buffer+2 dex bne _stl1 p}ldx #4 ;Mantisse lda #0_stl2 sta buffer+2,x dex bne _stl2 lda #$02 ;Exponent p}sta buffer+7 stwvar 7,_r1 ;Real uebergeben ldy #7 ;8 Byte_stl3 lda buffer,y sta (_r1),y p}dey bpl _stl3_st ldx _t# end;bergeben ldy #7 ;8 Byte_stl3 lda buffer,y sta (_r1),y p+function status(drive:integer; var controller,timeout,unuse:integer):integer; begin status:=0;#a stx _t ldat} #'1 ;ID:= Disk sta ddevic stvar 15,dunit ;Drive # lda #'S ;Get Status sta dcomnd t} lda #$40 ;Daten empfangen sta dstats ldw dbuf,buffer lda #7 ;Timeout := 7 sec sta dtim t} ldw dbyt,4 ;buflen := 4 jsr ussiov ldvar 5,dstats ;Error Status ldind 13,buffer ;Drive Status t} iny lda #0 sta (_r1),y ldind 11,buffer+1 ;Controler Status iny lda #0 sta (_r1),y ldind 9,buffet}r+2 ;Time out Format iny lda #0 sta (_r1),y ldind 7,buffer+4 ;Unuse iny lda #0 sta (_r1),y t} ldx _t# end;rmat iny lda #0 sta (_r1),y ldind 7,buffer+4 ;Unuse iny lda #0 sta (_r1),y tfunction writeconfig(Drive,sector_per_track,byte_per_sector:integer):integer; begin writeconfig:=0;#a stx _t+1 x} stwvar 7,_r1 stvar 9,_r0 lda #40 sta buffer ;Tracks lda #1 sta buffer+1 ;Step Rate lda _rx}0 sta buffer+3 ;Sec per Track Lo lda #0 sta buffer+4 ;Heads sta buffer+2 ;Sec per Track Hi sta bx}uffer+9 ;Baut Rate sta buffer+10 ;Reserv Hi sta buffer+11 ;Reserv Lo sta buffer+5 ;Density := SD ldx}a #4 ldy _r0 cpy #26 bne _dd sta buffer+5 ;Density := MD bne _sd_dd ldy _r1+1 beq _sd sta bufx}fer+5 ;Density := DD_sd lda _r1+1 sta buffer+6 ;Byte per Sec Hi lda _r1 sta buffer+7 ;Byte per Sec Lo x} lda #255 sta buffer+8 ;Online lda #'1 ;ID:= Disk sta ddevic stvar 11,dunit ;Disk # lda #'x}O ;Set Config sta dcomnd lda #$80 ;Daten Output sta dstats ldw dbuf,buffer ;dbuf := buffer x} lda #7 ;Timeout := 7 sec sta dtim ldw dbyt,12 ;buflen := 12 jsr ussiov ldvar 5,dstats ;Fehlerx}status bmi _wc ;Fehler lda dunit ;Neue Werte Setzen asl tax lda buffer+7 sta b_p_s+1,xx} lda buffer+6 sta b_p_s,x lda buffer+3 sta s_p_t,x _wc ldx _t+1# end; lda buffer+7 sta b_p_s+1,xx^function writebuffer(drive:integer):integer; begin writebuffer:=0;#a stx _t lda #'1 ;ID:= Disk st|}a ddevic stvar 7,dunit lda #'Q ;Schreib Trackbuffer sta dcomnd lda #0 ;Kein Daten IO sta d|}stats lda #7 ;7 sec Timeout sta dtim jsr ussiov ldvar 5,dstats ;Fehlerstatus ldx _t# end; d|{function Writesector(drive,sector:integer; var buffer:sectyp):integer; begin Writesector:=0;#a }stx _t lda #'1 ;Disk sta ddevic stvar 11,dunit ;Disk # := drive lda #'W ;Write S}ector sta dcomnd lda #$80 ;Daten Output sta dstats stwvar 7,dbuf ;Buffer lda #7 } ;7 sec Timeout sta dtim movbps ;Sector laenge stwvar 9,dsec ;Sector # lda dsec+1 } ;sector 1 bis 3 bne _wrt ;Boot Sectoren lda dsec ;128 Bytes cmp #4 bcs _wrt } ldw dbyt,128_wrt jsr ussiov ldvar 5,dstats ;Error Status ldx _t# end; cmp #4 bcs _wrt _function Writetrack(drive,sector:integer; var buffer:track):integer; begin Writetrack:=0;#a stx _t lda #}'1 ;Disk sta ddevic stvar 11,dunit ;Disk # := drive lda #$60 ;Write Track sta dcomnd} lda #$80 ;Daten Output sta dstats stwvar 7,dbuf ;Buffer lda #7 ;7 sec Timeout } sta dtim ldw dbyt,$900 ;SD Track lda dunit asl tax lda s_p_t,x cmp #26 bne _nom}d lda #$0d ;MD Track Hi Byte sta dbyt+1 bne _nodd_nomd lda b_p_s,x+1 beq _nodd lda #$1}2 ;DD Track Hi Byte sta dbyt+1_nodd stwvar 9,dsec ;Startsector jsr siov ;nicht in US l}dvar 5,dstats ;Error Status ldx _t# end;wvar 9,dsec ;Startsector jsr siov ;nicht in US l5(*************************************)(* *)(* Speedy 1050 Kyan Pascal Libery *)(* } *)(* (c) 1987 by Martin Krischik *)(* *)(* } Header File: *)(* Label und Macro Definitionen *)(* *)(*************}************************)#ab_p_s dw $0080 ;Bytes per Sector dw $0080 dw $0080 dw $0080}s_p_t dw $0018 ;Sector per Track dw $0018 dw $0018 dw $0018buffer ds $100 ;Sector Buf}ferussiov jmp SIOV ;US-SIO Einsprungddevic equ $0300 ;Serial IO IDdunit equ $0301 ;Disk Unitdcomnd equ $0302 };SIO Comandodstats equ $0303 ;SIO Statusdbuf equ $0304 ;SIO Buffer Adrdtim equ $0306 ;SIO Time outdunuse equ }$0307 ;Unbenutztdbyt equ $0308 ;SIO Buffer Lendaux1 equ $030a ;SIO Aux1daux2 equ $030b ;SIO Aux2dsec equ da}ux1 ;Disk Sector siov equ $e459 ;SIO Einsprungmovbps macro ;b_p_s+2*dunit->dbyt lda dunit asl} tax lda b_p_s,x sta dbyt lda b_p_s+1,x sta dbyt+1 endm# aslp(*************************************)(* *)(* Speedy 1050 Kyan Pascal Libery *)(* } *)(* Lese Ultra Speed SIO *)(* *)(* (c) }1987 by Martin Krisschik *)(* *)(*************************************)#aussio ds $0}220#procedure initus(drive:integer); begin#a stx _t lda #'1 ;Disk sta ddevic stvar 5,}dunit ;Disk # := drive lda #'h ;SIO Len lesen sta dcomnd lda #$40 ;Daten Input sta d}stats ldw dbuf,dbyt ;Buffer := dbyt lda #7 ;7 sec timeout sta dtim ldw dbyt,2 ;2 Byte}s lesen jsr siov bmi _nosp lda #'i ;SIO lesen sta dcomnd lda #$40 ;Daten Input} sta dstats ldw dbuf,ussio ;Buffer := ussio ldw daux1,ussio ;Adresse := ussio jsr siov bmi _n}osp ldw ussiov+1,ussio_nosp ldx _t# end;o ldw daux1,ussio ;Adresse := ussio jsr siov bmi _n7(*************************************)(* *)(* Speedy 1050 Kyan Pascal Libery *)(* } *)(* (c) 1987 by Martin Krischik *)(* *)(* Inst }allieren eines Programmes *)(* in das Speedy Ram *)(* *)(************* }************************)#astartadr equ _t+4endadr equ _t+6cont1 equ _t+8cont2 equ _t+10ipdrive equ _t+1 }2#procedure installprogram(drive:integer;name:diskname); var contab1:packed array [1..12] of char; contab2:packed} array [1..12] of char; begin#a stx _t tsx stx _t+1 clc lda _local } adc #>5 sta cont1 lda _local+1 adc #<5 sta cont1+1 lda _local } adc #>17 sta cont2 lda _local+1 adc #<17 sta cont2+1 stvar 45,ipdrive } ldvar 44,#$9b lda #'1 sta ddevic lda ipdrive sta dunit l}da #'N sta dcomnd lda #$40 sta dstats movw cont1,dbuf lda #7 sta }dtim ldw dbyt,12 jsr ussiov bpl ipcont2 jmp iperroripcont2 ldy #11incloop lda (}cont1),y sta (cont2),y dey bpl incloop ldvar 20,#18 ldvar 22,#4 l}dvar 24,#>256 ldvar 23,#<256 ldx #7*16 lda #open sta iccom,x clc } lda _local adc #>29 sta icbadr,x lda _local+1 adc #<29 sta icbadr+1,x } lda #4 sta icaux1,x lda #0 sta icaux2,x jsr ciov bpl ip1loop } jmp iperrorip1loop jsr getadrip2loop sec lda endadr sbc startadr sta _r1 ld}a endadr+1 sbc startadr+1 sta _r1+1 inw _r1 lda _r1+1 beq ipnpage } jsr iprd256 jsr ipwr inc startadr+1 jmp ip2loopipnpage jsr iprd jsr ipwr } jmp ip1loop iperror ldx _t+1 txs ldx _t tya ldy #45 sta (_l}ocal),y lda #0 iny sta (_local),y# writeln('Fehler beim Programieren der Speedy'); wri}teln('Fehler Nr.: ',drive); writeln('Programm : ',name:16);#a jmp _quitiprd256 ldw _r1,256iprd ldx }#7*16 lda #getchar sta iccom,x lda #>buffer sta icbadr,x lda #= 128 then begin writeln(chr(17}55),chr(155),'Fehler beim Setzen des Drive Status'); writeln(chr(155),'Kontolieren sie bitte die Einstellung'); 8} writeln('Ihres Speedy Laufwerkes und druecken'); writeln('sie ein  fuer einen neuen Versuch.'); ch:9}=getkey end until (err<128) or not (ch in ['J','j','','']) end;procedure config(spt,bps:integer); var err :} :integer; begin repeat err:=writeconfig(1,spt,bps); if err >= 128 then begin writeln(chr(155),c;}hr(155),'Fehler beim Konfigurieren.'); writeln(chr(155),'Kontolieren sie bitte die Einstellung'); writeln('<}Ihres Speedy Laufwerkes und druecken'); writeln('sie ein  fuer einen neuen Versuch.'); ch:=getkey =}end until (err<128) or not (ch in ['J','j','','']) end;procedure format; var err:integer; begin writeln(>}chr(155),'Legen Sie bitte eine Diskette ein und'); writeln('druecken sie  zum formatieren'); if getkey in ['J','j'?},'',''] then begin repeat err:=autoformat(1); if err >= 128 then begin writeln(chr(155@}),chr(155),'Fehler beim Formatieren'); writeln(chr(155),'Kontolieren sie bitte die Einstellung'); wriA}teln('Ihres Speedy Laufwerkes und druecken'); writeln('sie ein  fuer einen neuen Versuch'); ch:=geB}tkey end until (err<128) or not (ch in ['J','j','','']) end end;begin openkey; fullscr; repeaC}t write ('}堠'); writeln('㩠'); writeD}ln('Diese Programm ist in Kyan Pascal'); writeln('geschrieben.'); writeln; write(chr(155),chr(155),'FormatierenәE}D,D oderD?'); ch1:=getkey; Status:=1+128; write(chr(155),chr(155),'Formatieren mit Verify ʯ?'); if geF}tkey in ['N','n','',''] then status:=status+32; write(chr(155),chr(155),'Dos Sectoren Schreiben ʯ?'); ifG} getkey in ['N','n','',''] then status:=status+16; repeat write ('}H}'); writeln('㩠'); writeln(chr(155),chr(155),' ormatieren'); writI}eln(' eue Parameter'); writeln(' nde'); writeln(chr(155),chr(155),'Deine Wahl'); ch:=getkey; ifJ} ch in ['F','f','',''] then begin if ch1 in ['M','m','',''] then config(26,128) eK}lse if ch1 in ['D','d','',''] then config(18,256) else config(18,128);L} drive; format; end; until ch in ['N','n','','','E','e','',''] until ch in ['E','e','',M}'']end.drive; format; end; until ch in ['N','n','','','E','e','',''] until ch in ['E','e','',  0 - *6 70  *L: G ! 4 ! !D E BHI VL BO} D!EHI V08! !H!!I !D!E V0 `BD!EJK V` B V`error loading pascaP}l libraryD8:lib h ) Hą )eh Lk h LQ}k h   8  8   8 !   8   8   8 !R}   8   8   8 ! R  8  8 Q! ٠  8   8 QS}! ڠ  8   8 Q!Lk h!  ͠" L"K:  Lk hT}   F  5 FLk h F  81DU}  Y F O  % L   "    ̠# L#Fehler beim Setzen des DriveV} Status# # } t   "  %$ LJ$Kontolieren sie bitte die Einstellung% % } te$ L$W}Ihres Speedy Laufwerkes und druecken  "$ $ } t$ L$sie ein  fuer einen neuen Versuch.  "% X}% } t 8 " 5 F O   錩J  ˌj  ˌ ь ; UM# L Lk hY} F  8(    1OZ}ii   Y F O  ' L   "    X& Lr&F[}ehler beim Konfigurieren.  } t   "  & L&Kontolieren sie bitte die Einstellung% %\} } t& L 'Ihres Speedy Laufwerkes und druecken  "$ $ } t1' LV'sie ein  fuer einen neuen Versu]}ch.  "% % } t 8 " 5 F O   錩J  ˌj  ˌ ь ; Uw^}% LLk h   "  ( L3(Legen Sie bitte eine Diskette ein und% % } tN( Ln_}(druecken sie  zum formatieren  "  } t8 " 錩J  ˌj  ˌ ь* L F  8`}1  Y F O  r* L   "    C) LZ)Fehla}er beim Formatieren  } t   "  ) L)Kontolieren sie bitte die Einstellung% % } b}tР) L)Ihres Speedy Laufwerkes und druecken  "$ $ } t* L=*sie ein  fuer einen neuen Versuchc}  "$ $ } t 8 " 5 F O   錩J  ˌj  ˌ ь ; Uˠ( Ld}Lk h " y!}   "  * L#+( ( };+ Lc+e}㩠  "( ( } t   "    + L+Formf}atierenD,D oderD?  } 8 " 5  錩M  ˌm  ˌ ь`, L  g} 8   8  8 Y%L,  錩D  ˌd  ˌ ьɠ, L   8   8q}SBSP TXTBDISKCONTE BDISPLAY E B!JMPTAB E B8MAP E B?PIA E BMZEROPAGEE B^ADDCOMM F BcAFORMAT F BfCLRDISK F BjCLRTRACKF BnFORMAT F B rGETCONFIF B~GETSIO F BJUMP F BJUMPQUITF BMFORMAT F BPUTSEC F BRAMTEST F BRCONFIG F BRDTRACK F BREADSEC F BROMTEST F B SETCONFIF BSETDRIVEF BSETSLOW F BSIOLEN F BSIOSPEEDF B SPEEDTSTF BSTATUS F B WCONFIG F BWRITEBUFF BWRITESECF BWRTRACK F B SPEEDY H B INITUS P B$ INSTPROGP B-SPEEDY T B2FORMAT PA B!NFORMAT B xDISPLAY AS BDISPLAY SC BDRVTEST PA B-DRVTEST BRESTORE PA B#RESTORE B{DUNGEON PA   8 Y%L,   8  8  8 Y%    8   "r}    P- Lm-Formatieren mit Verify ʯ?  }8 " 錩N  ˌn  ˌ ьʠ- Ls}   O  8   "    . L.Dos Sectoren Schreiben ʯ?  t}}8 " 錩N  ˌn  ˌ ьz. L   O  8  O 8 /#   "u}    Ǡ. L. ormatieren  } t. L/ eue Parameter  "  } t&/ v}L-/ nde  "  } t 8 " 5  錩F  ˌf  ˌ ь/ L ' w} 錩N  ˌn  ˌE  ˌe  ˌ ь. L  錩E  ˌe  ˌ ь֠* L Lk' p;**************************************;* *;* Display Test Programm fuer Speedy *;* y} *;* (c) 1987 by Martin Krischik *;* *;*********z}*****************************; include sa>jmptab.e include sa>zeropage.e include sa>display.e {} include sa>map.e;buzlen equ freezerobuzfreq equ freezero+1; org userprog-6; dw $ffff |} dw start dw end-1;Start jsr clrdsp ldy #$03 jsr fulldisp ldx #$03 jsr x}}2wait lda #$00mainloop tay sta density jsr hexout tya pha jsr sound ~} ldx #$05 jsr x2wait pla clc adc #$11 bcc mainloop ldy #$3 } jsr Fulldisp jsr dendsp lda #$00 sta track jsr tradja jmp send43;Sound e}or #$ff and #$0f asl adc #$10 sta buzfreq lda #$0f sbc buzfreq } asl asl sta buzlen lda buzfreqbuzloop taxBudel1 dex bne budel1 stx buzzer} taxBudel2 dex bne budel2 dec buzlen bne buzloop rts;Fulldisp lda #$ff } sta disp1 sta disp10 sta density jsr bell1 jsr bell1 jsr clrdsp ldx} #$01 jsr x2wait dey bne fulldisp rtsend; jsr bell1 jsr clrdsp ldxPw  [ @ H 8 hi [ !LZI) i @Ɛ`@@@  䥆}`w  [ @ H 8 hi [ !LZI) i @Ɛ`@@@  (*************************************)(* Speedy Drive Test in Kyan Pascal *)(* (c) 1987 by Martin Krischik *)(****}*********************************)#i boot.hprogram Drive_test(input,output);#i speedy.h#i dosio.h#i inline.hconst m}axstring=256;type#i string.t#i dosio.tvar keyboard :file of char; ch :char; err :integer;#i ins}tprog.p#i speedtst.f#i jumpquit.f#i ramtest.f#i romtest.f#i initus.p#i jump.f#i position.p#i setcolor.p#i getkey.f#}i consol.f#i upper.f#i tohex.p#i hex.f#i poke.Pprocedure fullscr;begin setcolor(4,12,4); setcolor(2,14,1); setc}olor(1,14,6); poke(82,0);end;procedure test1; var err,adr:integer; hexadr :hexstring; begin err:=ramtest}(1,adr); tohex(adr,hexadr); if (err<128) and (adr=-24576) then writeln(' ok., Adresse: $',hexadr) } else writeln('Fehler: ',err:3,', Adresse: $',hexadr); writeln('Bittedruecken.'); repeat until co}nsol<>7 end;procedure test2; var err:integer; begin err:=romtest(1); if err<128 then writeln(' } ok.') else writeln(' Fehler',err:3); writeln('Bittedruecken.'); repeat until consol<}>7 end;procedure test3; var speed:real; err :integer; begin writeln('Bittedruecken.');} writeln(' Soll Speed: 288.0ms.'); write (' Ist Speed:'); repeat err:=speedtest(1,speed); posit}ion(15,16); write(speed:5:1,'ms '); if speed<287.0 then write('zu Klein. ') else if speed}>289.0 then write('zu Gross. ') else write('grad Recht.'); until consol<>7; end;proced}ure test4; var err:integer; begin writeln('Schauen Sie auf das Drive-Display'); err:=jump(1,hex('8000'),40);} end;begin openkey; fullscr; initus(1); installprogram(1,'D1:DISPLAY.SC '); repeat write ('}婗}ﱺ堠'); writeln('㩠'); writeln(' am Test'); w}riteln(' prom Test'); writeln(' peed Test'); writeln(' isplay Test'); writeln(' eenden');} writeln('Deine Wahl?'); ch:=upper(getkey); if ch='R' then test1; if ch='E' then test2; if ch='S' then }test3; if ch='D' then test4; err:=jumpquit(1,hex('ff03')); until ch='B'end.h='E' then test2; if ch='S' then X 5 - *6 75  $2L: G ! 4 ! !D E BHI VL B} D!EHI V08! !H!!I !D!E V0 `BD!EJK V` B V`error loading pasca}l libraryD8:lib}}LY hiiii-,1N@}   "L" pBiDiEJK VL" $8嘅噅日 # $晭}L" # $L"-ȑ# L6#Fehler beim Programieren der Speedy  "# # } t[# Lg#Fehler Nr.: }  "  }- F O  w t# L#Programm :  "  } F  } tL* }pBD!EHI VL" !`1O   "L"P!}    &L"O   "L"`pBHI V0` $ $% $ $`p B V䦕}/Lk h F  81 L@!    "08!N!n!n}!!!ȱ! F O Lk h F  81 M }ȱ  " F O Lk h F  81 L@ȱ  }  " F O Lk h F  81L   " F O }Lk}}}} h1h@  Y0-i@}ۍ&ۍ &  Y0 ۍ"&"Lk h F  81 L ȱ  Y} F O Lk hTUȱV Lk h!  /* L1*K:  }Lk h   F  5 FLk h F  8Р F }OLk h F F 5)`0)ߑ FLk h F O2+ L6+0000 }eȱ e+ e+ LkHJJJJ p+h)  0i6` h F  8)0#: )ɭ}AG6  && եȑ F O Lk h F   8 F 88} & 8 F O 8  F 8 + F O  F O`  n R, L, L, ok., }Adresse: $  "  } F  } tLl-, L-Fehler:  "  } F O  w}9- LF-, Adresse: $  } F  } tv- L-Bittedruecken.  "  } t8魷} *  s- L Lk h F   88 y& 8 F O  Y. L-. }L;. ok.  "  } tL.c. Lq. Fehler  "  } F O  w t. }L.Bittedruecken.  "  } t8 *  sܠ. LLk h/ L;/Bi}ttedruecken.  "  } t`/ Lw/ Soll Speed: 288.0ms.  "  } t/ L/ }Ist Speed:  "  } F   8  F 88 $ 8   8  } 8 ) F J    " R0 LU0ms   } F J A 0 L0 L0zu Klein. }  "  }L.1 F J A 1 L۠0 L0zu Gross.  "  }L.1 1 L1grad Recht.}  "  }8 *  s / LLk hm1 L1Schauen Sie auf das Drive-Display}  "# # } t F   8 ۠1 L18000 e8 + 8 (  88} t) 8Lk h *   8 (   8 j2 Lz2D1:DISPLAY.SC e "2 L2}}ﱺ堠  ") ) }٠2 L3㩠  }"* * } t(3 L63 am Test  "  } t[3 Lk3 prom Test  "  } t}3 L3 peed Test  "  } tŠ3 L3 isplay Test  "  } t3 L 4 ee}nden  "  } t.4 L;4Deine Wahl?  "  } t  8 G* 58} * 5 R  n4 L + E  nР4 L - S  n4 L / }D  n5 L V1    8 F5 LJ5ff03 e8 + 88 % 8 }B  n2 L Lk   8 F5 LJ5ff03 e8 + 88 % 8 "(*************************************)(* *)(* Alternate Reality the Dungeon *)(* } Character Wiederbelebung *)(* *)(* (c) 18.09.87 by Martin Krischik *)(* } *)(*************************************)#i boot.hprogram dungeon(input,output);#i speedy.h}#i inline.htype#i speedy.tvar sector2:sectyp; err :integer; i :integer; wahl :char;#i getkey.v}#i consol.f#i getkey.f#i upper.f#i poke.p#i setcolor.p#i readsec.f#i writesec.ffunction testdisk:boolean; var x:pa}cked array[1..8] of char; i:integer; begin x:='AR CHAR!'; testdisk:=true; for i:=1 to 8 do if sec}tor2[i]<>x[i] then testdisk:=false; end;procedure druckstat(n:integer); var i:integer; begin write('',}n:1,' '); n:=n-1; if sector2[9+n]=chr(0) then writeln('ist Frei!') else begin for i:=25+n*26} to 25+n*26+25 do if sector2[i]<>chr(0) then write(sector2[i]) else write(' '); } if sector2[9+n]=chr(255) then writeln(' OK') else writeln(' LOST'); end; end;b}egin openkey; poke(82,0); setcolor(4,11,4); setcolor(2,4,3); setcolor(1,4,7); repeat write('}}'); write('砠'); writeln('㩠}'); writeln('Diese Programm ist in Kyan Pascal ge-'); writeln('schrieben. Entwicklungszeit: 1h 45" '); } writeln('Bitte legen sie ihre Altenate Reality'); writeln('The Dungeon Character Disk ein und'); writeln('drueck}en sie.'); repeat until consol<>7; err:=readsector(1,2,sector2); if testdisk then begin writ}e('}'); write('砠'); writeln('}㩠'); for i:=1 to 4 do druckstat(i); writeln('Welchen Charac}ter wiederbeleben?'); writeln('0 fuer Keinen!'); repeat wahl:=upper(getkey); until(wahl>='0}') and (wahl<='4'); i:=ord(wahl)-48; if i<>0 then begin if sector2[9+i-1]<>chr(255) the}n begin sector2[9+i-1]:=chr(255); sector2[13+i-1]:=chr(255); er}r:=writesector(1,2,sector2); end; err:=readsector(1,2,sector2); druckstat(i); } end; end else writeln('Keine Character Disk!'); writeln('Druecken siefuer Neustart oder'); wr}iteln('eine andere Taste fuer Ende'); until upper(getkey)<>'N';#a jmp $e477#end.en siefuer Neustart oder'); wrX 0 - *6 70  (L:! G ! 4 ! !D E BHI} VL BD!EHI V08!!H!!I!D!E V0 `BD!EJK V` B V`error lo}ading pascal libraryD8:lib}}LY h F  8Р F OLk h}!  " L"K:  Lk h   F  5 F}Lk h F F 5)`0)ߑ FLk h F  81 }R@ȱ !! ȱ      ," F O Lk h} F  81 Wȱ !! ȱ      ,"} F O Lk h F$ L$AR CHAR! e F  5  II唰L% 2} 2  F O8 Iuu F F O8 Iu}u s% L F  5  Ԍ  @L$ FLk h   "}  F O  w& L&   } F F O   8   F O 8} Iuu  n& L& L&ist Frei!  "  } tL(  F O }    F O     II唰L( 2 2  F O8} Iuu  sܠ' L  F O8 Iuu  "}  L'   "    Ԍ  @L,'   F O 8 I}uu  n( L}( L( OK  "  } tL(( L( LOST  "  } t} Lk  h e"( L)}  ") ) }6) L^)}砠  "( ( }) L)㩠  "( ( } t}͠) L)Diese Programm ist in Kyan Pascal ge-  "' ' } t* L=*schrieben. Entwicklungszeit: 1h 36" }  "$ $ } tb* L*Bitte legen sie ihre Altenate Reality  "' ' } t* L*The Dungeon Char}acter Disk ein und  "" " } t* L +druecken sie.  "  } t8 /" } s$+ L    8   8  88 @# 88 r$/ L+ L+}}  ") ) }+ L&,砠  "( }( }H, Lp,㩠  "( ( } t  II唰L,}  O 8 % L,- L(-Welchen Character wiederbeleben? } "" " } tM- L[-0 fuer Keinen!  "  } t  8 " 58 " 5} 0   4  7 Rv- L  0   8  O  s/ L }   O   8 Iuu  s/ L    O }   8 Iuu  5    O   8} Iuu  5    8   8  88 # 8  O }8 %L// L/Keine Character Disk!  "  } t/ L0Druecken siefuer Neustart oder  "#} # } t60 LQ0eine andere Taste fuer Ende  "  } t 8 " 58 "N}  s( L LkLQ0eine andere Taste fuer Ende  "  } t 8 " 58 "N(*************************************)(* *)(* Alternate Reality the Dungeon *)(* } Character Monitor *)(* *)(* (c) 10/87 by Martin Krischik *)(* } and Peter Sabath *)(* *)(*************************************)#i boot.hpro}gram dungeon(input,output);#i speedy.h#i inline.htype modi =(s,c); byte =0..255; absolut=0..32767; se}ctyp =packed array [1..128] of char;var sector2:sectyp; figur :packed record case mode:modi of } s:(s: packed array [3..40] of sectyp); c:(c: packed array [25344..30207] of char) } end; err :integer; i :integer; n :integer; wahl :char;#i getkey.v#i consol.f#i getkey }.f#i upper.f#i poke.p#i setcolor.p#i position.p#i initus.p#i readsec.f#i writesec.f#i writebuf.fprocedure copyright }; begin write('}'); write('򠠠'); } write('㩠'); writeln('蠠'); end;funct }ion menuende:char; begin writeln('Ende'); writeln('Deine Wahl'); menuende:=upper(getkey); end;funct }ion testdisk:boolean; var x:packed array[1..8] of char; i:integer; begin x:='AR CHAR!'; testdisk:=true; } for i:=1 to 8 do if sector2[i]<>x[i] then testdisk:=false; end;procedure druckstat(n:integer); var i}:integer; begin write('',n+1:1,' '); if sector2[9+n]=chr(0) then writeln('ist Frei!') else begin} for i:=25+n*26 to 25+n*26+25 do if sector2[i]<>chr(0) then write(sector2[i]) else } write(' '); if sector2[9+n]=chr(255) then writeln(' OK') else writeln(' LOST'}); end; end;procedure pruefsumme; var adr:integer; begin figur.mode:=c; adr:=address(figur.c[25344]);}#a stx _t ;X Register retten stwvar 5,_r1 ;adr -> _r1 lda #0 ;Alte Pruefsumme loeschen } ldy #$8e ;figur.c[$638e] = Pruefsumme sta (_r1),y ldy #$09 ;figur.c[$6309] = Startwert lda (_}r1),y ldy #0 ldx #$12 ;$12 Pages clc ;Carry nur am Anfang loeschenprloop adc (_r1),y } iny ;Naechtes Byte bne prloop inc _r1+1 ;Naechste Page dex ;Eine Page weniger } bne prloop tax ;Pruefsumme in X retten stwvar 5,_r1 ;adr -> _r1 ldy #$8e ;figur.c[$638e}] = Pruefsumme txa ;Pruefsumme aus X restaurieren sta (_r1),y ;Neue Pruefsumme setzen ldx _t } ;X register Restaurieren# end;function figur_b(nr:integer):byte; begin figur.mode:=c; figur_b :=ord(fi}gur.c[nr]) end;function figur_i(nr:integer):integer; begin figur_i:=figur_b(nr)*256+figur_b(nr+1) end;procedur}e to_figur_b(nr,wert:integer); begin figur.mode :=c; figur.c[nr]:=chr(wert) end;procedure to_figur_i(nr,wert:i}nteger); begin to_figur_b(nr,wert div 256); to_figur_b(nr+1,wert mod 256) end;procedure inp_b(x,y,nr:integer);} var wert:byte; begin position(x-1,y); write(''); read(wert); to_figur_b(nr,wert); end;procedure i}np_i(x,y,nr:integer); var wert:absolut; begin position(x-1,y); write(''); read(wert); to_figur_i(nr,we}rt); end;procedure modify(n:integer); var wahl:char; procedure lese(n:integer); var i:integer; begin } copyright; writeln('Lade Character:'); druckstat(n); figur.mode:=s; for i:=3 to 40 do err!}:=readsector(1,i+n*184,figur.s[i]); figur.mode:=c; end; procedure schreibe(n:integer); var i:integer; "}begin copyright; writeln('Schreibe Character:'); druckstat(n); writeln('Alte Pruefsumme:',figur_b(2#}5486):3); pruefsumme; writeln('Neue Pruefsumme:',figur_b(25486):3); figur.mode:=s; for i:=3 to 40 do$} err:=writesector(1,i+n*184,figur.s[i]); err:=writebuffer(1); figur.mode:=c; end; procedure zustand%}; var wahl:char; function exp(nr:integer):real; begin if figur_i(nr+2)>=0 then exp:=65536.&}0*figur_i(nr)+figur_i(nr+2) else exp:=65536.0*figur_i(nr)+figur_i(nr+2)+65536.0; end; procedure '}inp_exp(x,y,nr:integer); var wert:real; begin position(x-1,y); write(''); read(wert);(} to_figur_i(nr,trunc(wert/65536.0)); wert:=wert-trunc(wert/65536.0)*65536.0; if wert>32767 then )} to_figur_i(nr+2,trunc(wert-65536.0)) else to_figur_i(nr+2,trunc(wert)); end; procedure wert(*}nr:integer); begin writeln(figur_b(nr):4,figur_b(nr+1):4,' +/-: 0'); end; procedure inp_wert(x,y,n+}r:integer); var wert:integer; begin position(x-1,y); write(''); read(wert); to,}_figur_b(nr ,figur_b(nr )+wert); to_figur_b(nr+1,figur_b(nr+1)+wert); end; begin repeat co-}pyright; writeln('Character Level:',figur_b(25404):3); writeln('Experience :',exp(25405):10:0); .} writeln('Level wechsel :',exp(25409):10:0); writeln('Hitpoint :',figur_i(25413):5); writeln/}('Hitpoint max :',figur_i(25415):5); write('STA'); wert(25417); write('CHR'); wert(25425); 0} write('STR'); wert(25433); write('INT'); wert(25441); write('WIS'); wert(25449); write('1}SKL'); wert(25457); write('SPD'); wert(25465); writeln('Moral :',figur_b(25477):3); wa2}hl:=menuende; if wahl in ['A'..'M'] then case wahl of 'A': inp_b( 19, 5,25404); '3}B': inp_exp( 19, 6,25405); 'C': inp_exp( 19, 7,25409); 'D': inp_i( 19, 8,25413); 'E': i4}np_i( 19, 9,25415); 'F': inp_wert(19,10,25417); 'G': inp_wert(19,11,25425); 'H': inp_we5}rt(19,12,25433); 'I': inp_wert(19,13,25441); 'J': inp_wert(19,14,25449); 'K': inp_wert(196},15,25457); 'L': inp_wert(19,16,25465); 'M': inp_b (19,17,25477); end until wahl='X'7} end; procedure ausruestung(adr:integer); var wahl:char; nr :integer; begin repeat co8}pyright; writeln('Gold :',figur_i(adr ):5); writeln('Silber :',figur_i(adr+ 2):5); 9} writeln('Copper :',figur_i(adr+ 4):5); writeln('Gems :',figur_i(adr+ 6):5); write:}ln('Juwels :',figur_i(adr+ 8):5); writeln('Foot Packets :',figur_b(adr+10):3); writeln('Wate;}r Flask :',figur_b(adr+11):3); writeln('Unlit Torches :',figur_b(adr+12):3); writeln('Crystals :<}',figur_b(adr+13):3); writeln('Keys :',figur_b(adr+14):3); writeln('Compasses :',figur_b(a=}dr+15):3); writeln('Timepieces :',figur_b(adr+16):3); wahl:=menuende; nr:=ord(wahl)-65; >} if wahl in ['A'..'E'] then inp_i(18,5+nr,adr+2*nr); nr:=nr+5; if wahl in ['F'..'L'] then ?} inp_b(18,nr,adr+nr); until wahl='X' end; procedure pos; var plan,level, ost ,ost2 , nord,sued ,@} m ,wert :integer; max :packed array [0..6] of integer; function pos_ok:boolean; var test:boolean;A} begin test:=true; if (sued>max[plan]) or (sued<0) then test:=false; if (ost>max[plan]) or (osB}t<0) then test:=false; if not test then begin copyright; writeln('Eine solche PositC}ion ist nicht'); writeln('moeglich.'); writeln('Bitte schlagen sie im Handbuch Seite 9'); writD}eln('nach um zu Erfahren welche positionen'); writeln('moeglich sind.'); writeln('Druecken sie.')E}; repeat until consol<>7; end; pos_ok:=test end; begin max[0]:=31; max[1]:=31; maxF}[2]:=31; max[3]:=31; max[4]:=31; max[5]:=15; max[6]:=7; repeat copyright; plan:=figur_b(25365G}); sued:=figur_b(25364); ost :=figur_b(25363); case plan of 0: begin level:=1; H} ost2 :=ost; nord :=31-sued+32; end; 1: begin level:=1; ost2 :I}=ost+32; nord :=31-sued+32; end; 2: begin level:=1; ost2 :=ost; J} nord :=31-sued; end; 3: begin level:=1; ost2 :=ost+32; noK}rd :=31-sued; end; 4: begin level:=2; ost2 :=ost; nord :=31-sued; L} end; 5: begin level:=3; ost2 :=ost; nord :=15-sued; end;M} 6: begin level:=4; ost2 :=ost; nord :=7-sued; end end; N}writeln('Intene Position:'); writeln('Auf Plan :',plan:1); writeln('Nach Sueden:',sued:2); writelnO}('Nach Osten :',ost:2); writeln('Spiel Position:'); writeln('In Level :',level:1); writeln('NaP}ch Norden:',nord:1); writeln('Nach Osten :',ost2:1); wahl:=menuende; if wahl in ['A'..'F'] then Q}case wahl of 'A': begin position(14,7); write(''); read(plan);R} if pos_ok then to_figur_b(25365,plan); end; 'B': begin S} position(14,8); write(''); read(sued); if pos_ok then T} to_figur_b(25364,sued); end; 'C': begin position(14,9); wrU}ite(''); read(ost); if pos_ok then to_figur_b(25363,ost); V} end; 'D': begin position(14,13); write(''); read(level); W} case level of 1: if plan>4 then plan:=0; 2: plan:=X}4; 3: plan:=5; 4: plan:=6; end; if pos_ok then Y} to_figur_b(25365,plan); end; 'E': begin position(14,14); Z} write(''); read(nord); if (level=1) and (nord<32) then begin [} sued:=31-nord; if plan<2 then plan:=plan+2 end\} else if level=1 then begin sued:=31-nord+32;]} if plan>1 then plan:=plan-2 end else^} sued:=max[plan]-nord; if pos_ok then begin to_f_}igur_b(25364,sued); to_figur_b(25365,plan) end end; 'F': beg`}in position(14,15); write(''); read(ost2); if (level=1) a}and (ost2>31) then begin ost:=ost2-32; if plan in [0,2] then b} plan:=plan+1 end else begin oc}st:=ost2; if plan in [1,3] then plan:=plan-1 end; d} if pos_ok then begin to_figur_b(25363,ost); to_figur_b(2536e}5,plan) end end end until wahl='X'; end; begin lese(n); repeatf}; copyright; druckstat(n); writeln('Was moechten Sie?'); writeln('ustand'); writeln('usrg}uestung'); writeln('ilden Ausruestung'); writeln('osition'); writeln('ese von Disk'); writeln('h}chreiben auf Disk'); writeln('nde'); writeln('Deine Wahl'); wahl:=upper(getkey); if wahl in ['Z'i},'A','G','P','L','S'] then case wahl of 'Z':zustand; 'A':ausruestung(25521); 'G':ausruej}stung(30065); 'P':pos; 'L':lese(n); 'S':schreibe(n); end; until wahl='E'; end;pk}rocedure restore(n:integer); begin copyright; druckstat(n); writeln('Ihr Character ist "LOST", wuenschen');l} writeln('das ich ihn'); writeln('iederbelebe, nur zum'); writeln('enderen lade,'); writeln('eides macm}he oder'); writeln('ichts'); writeln('Deine Wahl'); wahl:=upper(getkey); if wahl in ['W','B'] then bn}egin sector2[9+n]:=chr(255); sector2[13+n]:=chr(255); err:=writesector(1,2,sector2); err:=wro}itebuffer(1); err:=readsector(1,2,sector2); druckstat(i); end; if wahl in ['A','B'] then modip}fy(n); end;begin openkey; initus(1); poke(752,0); poke(82,0); setcolor(4,0,4); setcolor(2,12,3); setcolor(q}1,12,7); repeat copyright; writeln('Diese Programm ist in Kyan Pascal ge-'); writeln('schrieben.'); writelr}n('Auf einer Speedy 1050 wird die'); writeln('Disk I/O in Ultra Speed durchgefuehrt.'); writeln('ACHTUNG! Range unds} Input Errors werden'); writeln('nicht abgefangen. Also erst Denken dann'); writeln('Aendern. Grenzen: 255 oder 32767t}'); writeln('Bitte legen sie ihre Altenate Reality,'); writeln('The Dungeon, Character Disk ein und'); writeln(u}'druecken sie.'); repeat until consol<>7; err:=readsector(1,2,sector2); if testdisk then begin v} copyright; for i:=0 to 3 do druckstat(i); writeln('Welchen Character modifizieren?'); w}writeln('0 fuer Keinen!'); repeat wahl:=upper(getkey); until(wahl>='0') and (wahl<='4'); n:x}=ord(wahl)-48; if (n<>0) and (sector2[8+n]<>chr(0)) then if sector2[8+n]=chr(127) then begin y} restore(n-1); copyright end else begin modify(n-1);z} copyright end end else begin copyright; writeln('Keine Character{} Disk!'); end; writeln('Wuenschen Sie:'); writeln('eustart des Programms'); writeln('oot einer Disk');|} writeln('Deine Wahl'); wahl:=upper(getkey) until wahl='B';#a; jmp $e477#end. writeln('oot einer Disk');^