Commodore Disc 55

home *** CD-ROM | disk | FTP | other *** search

/ Commodore Disc 55 / Commodore_Disc_55_19xx_-_de.d64 / dv.quell < prev next >

Wrap

Text File | 2022-10-26 | 23KB | 1,288 lines

int len( ) begin ( , 0xffff , 0 find ) swap - bend int $<( ) int le ; begin swap ( swap , swap , swap len le = 1 + copy ) swap le ] + bend int inchar( str z ) begin , ( str ] , ( len ) + , z ] find ) nif fert str --] - : fert bend int val( ) int s , erg ; begin s = 0 erg = : lab0 s ]++ by ] nif ff 0x1f and nif lab0 : lab1 15 and ( erg ] 10 * ) + erg = : lab2 s ]++ by ] 0x1f and if lab1 erg ] : ff bend int scan( an en str n ) begin , nif fert : lab ( an ] , en ] , str by ]] find ) nif fert an = ( an ]++ , str ] , n by ] comp ) nif lab an --] : fert bend /* --- Bildschirm, Farbe und Cursor */ void modswap( ) begin 0 syscon 64 == if ff 0xff5f sys : ff bend void color( vf hf rf ) begin , 0 , vf --] 5 syscon by = hf ] nif ff 1 - 53281 by = rf ] nif ff 1 - 53280 by = : ff bend void at( y x ) begin yr by = y ] xr by = clc 0xfff0 sys bend char posxy( ) begin sec 0xfff0 sys xr by ] yr by ] bend void tab( ) begin ( posxy swap ) ( , swap at ) bend void +tab( ) begin ( posxy ) + tab bend void putc( ) begin ac by = 0xffd2 sys bend void putl( ) int zg ; begin zg = go rd : wr putc : rd zg ]++ by ] if wr bend void rputn( ) begin nif ff ( 10 / rputn ) swap 10 % '0' + putc : ff bend void putn( ) begin nif ff rputn return : ff '0' putc bend void print( liste ) int zg ; begin , 0 , liste zg = ] : lab putl 2 zg += ] if lab bend void fprint( string ) int par , zg ; begin , string par = ] zg = : lab1 zg by ]] nif ff zg by ]] '%' == if zahl zg ]++ by ] putc go lab1 : zahl 2 par += zg ]++ par ]] putn go lab1 : ff bend char getc( ) begin 0xffe4 sys ac by ] bend char key( ) begin : rd getc nif rd bend int getl( str lim ) def basin 0xffcf sys ac by ]; begin , go rd : wr swap str ]++ by = : rd basin '/n' == if ff swap lim ]-- if wr : ne basin '/n' == nif ne : ff 0 str ] by = str ] bend int getn( ) char number[ 8 ; begin number ( , 7 getl ) swap val bend char bfile[ 40 ; void open( lfn ger sek liste ) def setlfs 0xffba sys; def setnam 0xffbd sys; def fopen 0xffc0 sys; int zg ; begin , 0xffff , lfn ] ac by = ger ] xr by = sek ] yr by = setlfs sek ] not nif nam liste zg = ] not nif nam bfile swap : lab not $< ( 2 zg += ] ) not if lab bfile len : nam ac by = bfile xr = setnam fopen bend def # 0xffcc sys; void #i( ) begin # swap xr by = 0xffc6 sys bend void #o( ) begin # swap xr by = 0xffc9 sys bend void close( ) begin # swap ac by = clc 0xffc3 sys bend def stat 0x90 by ]; int load( ger fi adr ) begin , 0 , 0 ac by = ger ] xr by = adr ] 0 == 1 and yr by = 0xffba sys fi ] xr = ( len ) ac by = 0xffbd sys 0 ac by = adr ] xr = 0xffd5 sys xr ] bend int wait-ready( ) def ndx 3 syscon; def tastbuf 4 syscon; begin ndx by ] nif fertig ( "/3/134" , tastbuf by ] inchar ) if ff 0 ndx by = : schleife ndx by ] nif schleife ( "/3/134" , tastbuf by ] inchar ) : ff ( 0 ndx by = ) swap : fertig bend void dirop( fi ) begin ( 8 , swap , 0 , fi ] open ) 8 #i getc getc getc getc bend void dir( fi ger ) char zl , zh ; begin , 147 putc ( fi ] , ger ] dirop ) stat nif lab1 8 close return : lab1 wait-ready if fertig getc ( getc 256 * ) + putn ' ' putc : lab2 getc putc swap if lab2 '/n' putc getc getc stat nif lab1 : fertig stat ( 8 close ) swap nif fert key : fert 147 putc bend /* Menuesteuerung */ void menp( zg ) int zg ; begin zg = go pruef : s1 ( , zg ]++ by ] at ) go zeich : s2 ( putc ) : zeich zg ]++ by ] if s2 : pruef zg ]++ by ] if s1 bend int menw( mf lim sp str ) char rvon "/18" , rvoff "/146" ; int z , n , nr , zg ; begin , 0 , lim ]-- str ] nif s0 1000 > if wa str ] 1 - nr = : s0 1 n = go anf : lo ( zg by ]] , zg ] 1 + by ] at ) ( zg ] 2 + print ) : anf nr ] << mf ] + ] zg = 2 + by ] if anf1 sp ] nr -= go anf : anf1 ( zg by ]] , zg ] 1 + by ] at ) ( rvon , zg ] 2 + , rvoff print ) n ] if ff : wa ( str ] , key z = n = inchar ) nif cu 1 - nr = go lo : cu z ] '/n' == if lo swap ( 0 n = ) swap 29 == if ri swap 17 == if dn swap 157 == if li swap 145 == if ob : fe z ] 0 return : ri nr ] lim ] == if fe nr ] sp ] % 1 + sp ] == if fe nr ]++ go lo : li nr ] sp ] % nif fe nr ]-- go lo : dn nr ] sp ] + lim ] > if fe sp ] nr += go lo : ob nr ] sp ] - 0x8000 > if fe sp ] nr -= go lo : ff nr ] 1 + bend void mencrea( fz ) begin swap : ne swap fz ] = ( 2 fz += ) ( swap 2 + , 0xffff , 0 find ) 1 + ( by ] ) if ne bend /* -Erweiterung fuer Eingabekomfort-- */ void wputc( z n ) begin , go prf : wr z ] putc : prf n ]-- if wr bend void wputl( str n ) begin , go prf : wr str ] putl : prf n ]-- if wr bend int cuwe ; int scu( ) begin sec 0xfff0 sys xr ] cuwe = bend void pcu( ) begin xr = clc 0xfff0 sys bend void rcu( ) begin cuwe ] pcu bend char edl( str le ) begin , scu str ] putl rcu ( str ] , le ] getl ) bend void ksys( ) begin 0xbb5 = 0xbb1 sys 0xff 0xbb6 by = bend void cuon( ) begin 0 syscon 128 == if c128 204 by = return : c128 0xcd6f ksys bend void cuof( ) begin 0 syscon 128 == if c128 1 204 by = 207 by ] nif ff 1 205 by = 0 204 by = : prf 207 by ] if prf 1 204 by = : ff return : c128 0xcd9f ksys bend void cukey( ) begin cuon key ( cuof ) swap bend char fkey( ) char tast "/20/29/157{CBM-F}{CBM-C}{CBM-X}{CBM-V}{SHIFT-+}{CBM--}{SHIFT--}" ; int z , ptast ; begin ptast = : lab cukey z = ' ' >= ( z ] 'z' <= ) and ( z ] 'A' >= ( z ] 'Z' <= ) and ) or if fert ( ptast ] , z ] inchar ) if ff ( tast , z ] inchar ) nif lab : fert z ] return : ff 0 bend char fbegr "<>" ; void putlen( zg n ) begin , go prf : wr zg by ]] nif ff putc zg ]++ go prf : ff ' ' putc : prf n ]-- if wr bend void putf( sz lim ) begin , fbegr by ] putc scu sz ] putl ( ' ' , lim ] ( sz ] len ) - wputc ) fbegr 1 + by ] putc rcu bend char edf( sz lim prf ) def anf! vz ] sz ] == if next; def --]] --] by ]; def --]= --] by =; def ]++] ]++ by ]; def ]++= ]++ by =; def gr< vz ] gr ] <>; def pnex 157 putc go next; int vz , hz , z , gr ; begin , "/n" , ( sz ] , lim ] putf ) sz ] lim ] + 1 + hz = 2 - gr = sz ] ( len ) + 1 + vz = : an1 vz --]] hz --]= : an2 vz ] sz ] <> if an1 : next prf ] fkey nif ff 20 == if del swap 29 == if c> swap 157 == if c< swap z = gr< nif in. swap hz ] == if in= z ] vz ]++= putc scu hz ] putl rcu go next : in. swap hz = z ] swap by = putc pnex : in= z ] vz ]++= putc hz ]++ go next : del anf! vz --] 157 putc scu hz ] putl ' ' putc rcu go next : c< anf! vz --]] hz --]= pnex : c> gr< hz by ]] and nif next hz ]++] vz ]++= 29 putc go next : ff swap ( 146 putc ) swap ( vz ] hz ] $< ) bend char getf( sz lim prf ) begin , "/n" , 0 sz ] by = ( sz ] , lim ] , prf ] edf ) bend char maske[ 201 ; int szm ; int defm( str le ) begin , szm ] if ov maske szm = : ov le ] szm ]++ by = str ] szm ] = scu ( 2 szm += ) = 2 szm += 0 swap by = bend void clrm( ) int zg ; begin maske zg = szm = go prf : ne 0 zg ++] ] by = 4 zg += : prf by ] if ne bend void putm( ) int zg ; begin maske zg = szm = go prf : ne 3 zg += ] pcu ( 2 zg -= ] , zg --] by ] putf ) 5 zg += : prf by ] if ne 146 putc bend void edm( ) int zg , n ; begin putm : anf maske zg = go rd : auf zg ] maske == if ne 5 zg -= : ne 3 zg += ] pcu ( 2 zg -= ] , zg --] by ] , "/3/134/145/19/17/n" edf swap ) n = 3 < if ff swap 3 == if auf swap 4 == if anf 5 zg += : rd by ] if ne : ff n ] 1 - bend void getm( ) begin clrm edm bend int mwahl( ) int zg ; const up 145 dn 17 ; begin maske zg = : rd zg ] 3 + ] pcu fbegr by ] putc cukey ( 146 putc ) swap dn == if cdn swap up == if cup swap '/n' == nif rd zg ++] ] return : cdn 5 zg += by ] if rd : cup zg ] maske == if rd 5 zg -= go rd bend int fzahl , mema , fzzg ; def fzg 1 syscon; void setfz( ) begin fzahl = 1 + << fzg + ( fzg fzzg = ) = mema = bend void setfl( ) begin 1 + mema ] + mema = ( 2 fzzg += ) = bend void feld( ) begin << fzg + ] bend void flim( ) begin << fzg + 2 + ] swap ] - 1 - bend void fe,li( ) begin ( feld ) , swap flim bend int dfeld?( ) int n , zg ; begin zg = 0 n = go prf : ne swap feld zg ] == if ff : prf n ]++ fzahl <= if ne return : ff n ] bend int datlen( ) begin ( , 0xffff , '/n' find ) swap - bend int rzg , wzg ; int getd( str lim ) int leq , lez ; begin , rzg by ]] nif ff rzg ] ( , 0xffff , '/n' find ) swap - leq = lez = lim ] <= if ok lim ] lez = : ok ( rzg ] , str ] , lez ] copy ) leq ++] rzg += lez ] : ff str ] + ( 0 swap by = ) swap bend void getsm( ) int i ; begin 0 i = : rd ( i ] fe,li getd ) i ++] fzahl ] <> if rd bend void putd( ) begin wzg ] swap $< "/n" $< wzg = bend int putsm( ) int i ; begin 0 i = : wr i ] feld putd i ++] fzahl ] <> if wr wzg ] bend int puts( ) int i ; begin 0 i = : wr i ] feld putl '/n' putc i ++] fzahl ] <> if wr bend int dsa( ) int zg ; begin zg = : lab zg --] by ] if lab zg ++] bend int dfeld( zg n ) begin , zg ] dsa zg = go prf : ne zg ( ] , 0xffff , '/n' find 1 + ) swap = by ] nif ff : prf n ]-- if ne zg ] return : ff zg --] bend int ifeld , ian , indan , indend , izg , datend ; void getds( ) begin izg ]] nif ff dsa rzg = getsm return : ff clrm bend void skip+( ) begin izg ] indend ] <> nif ff 3 izg -= ] if ff 3 izg += 0 : ff bend void skip-( ) begin izg ] indan ] <> nif ff 3 izg += ] if ff 3 izg -= 0 : ff bend void ineu( ) int zg ; begin indan ] zg = go prf : ne ( , ifeld ] dfeld ) zg ] = : prf 3 zg -= ] if ne bend void datorg( ) int lz , sz ; char n "/n#" ; begin ( n 1 + ) by = 0 ( 2 syscon 2 - indan = ) = datend ] by = 2 syscon 5 - izg = sz = mema ] lz = '/n' swap by = go lab2 : lab1 0 lz ++] by = sz ] 2 + 0 swap by = lz ++] sz ] = 3 sz -= : lab2 ( lz ] , datend ] , n , 2 scan ) lz = if lab1 sz ] indend = 0 swap = ian ] ifeld = nif ff ineu : ff bend void d=such( suwort swlen obgr ) def o obgr; begin indan ] swap - 3 / , int u 1 , m ; : next u ] o ] >= if ff o ] u ] + >> m = 3 * indan ] swap - ( ] , suwort ] , swlen ] <comp ) nif gr= m ] 1 + u = go next : gr= m ] o = go next : ff o ] 3 * indan ] swap - izg = bend void d>such( suwort swlen obgr ) def o obgr; begin indan ] swap - 3 / , int u 1 , m ; : next u ] o ] >= if ff o ] u ] + >> m = 3 * indan ] swap - ( ] , suwort ] , swlen ] >comp ) if gr m ] 1 + u = go next : gr m ] o = go next : ff o ] 3 * indan ] swap - izg = bend void einsort( ) int dat , mf , dend ; begin dend = 2 + by ] mf = dend ]] dat = "/255/255" dend ] = ( dat ] , ( datlen 1 + ) , dend ] d>such ) ( dend ] 3 + , dend ] , izg ] swap - copy ) izg ] 2 + mf ] swap by = dat ] izg ] = : fert bend void datsort( ) int zg ; begin indan ] 3 - zg = go prf : so swap einsort : prf 3 zg -= indend ] > if so indan ] 3 - izg = getds bend void neuind( ) begin putm mwahl dfeld? nif ff 1 - ifeld = ineu datsort : ff bend void indin( ) begin ( 1 - , ifeld ] dfeld ) indend ] = indend ] 2 + by 0 swap by = indend ] einsort 3 indend -= 0 swap = bend void datan( ) int adr ; begin edm datend ] 1 + wzg = putsm 0 swap by = wzg ] datend = indin getds bend void >copy( q z n ) begin , q += n ] z += go prf : ne q --] by ] z --] by = : prf n ]-- if ne bend void datdel( ) int zg , da , le ; begin izg ]] nif nix dsa da = ( indend ] , 3 + , izg ] indend ] - >copy ) ( da ] ( len 1 + le = ) + , datend ] swap - 1 + da ] , swap copy ) le ] datend -= 3 indend += indan ] zg = go prf : korr le ] zg ] -= : prf 3 zg -= ] nif ff da ] > nif prf go korr : ff izg ]] if nix 3 izg += : nix bend int getz( ) int zg ; char number[ 8 ; begin number zg = : vo getc ' ' == if vo : wr swap zg ]++ by = getc ' ' == if ff swap '/n' == nif wr : ff 0 zg ] by = number val bend int text , liste , sfl , pz , menvar[ 13 ; void menu( ) int n 2 ; char m 23 1 "Neu" 23 5 "Aendern" 23 13 "Loeschen" 23 22 "Suchen" 23 29 "Index" 23 35 "Um" 24 1 "Disk" 24 6 "Print" 24 12 "Ende" 24 17 "Vor" 24 21 "Rueck" 24 27 "Mark" 24 32 "Opt/0" ; begin m menp ( menvar , m mencrea ) ( menvar , 13 , , n >>= menw ) bend void bild( ) int zg ; def .. zg ]++ by ]; begin 147 putc text ] zg = : rd .. nif ff '@' == if po swap '/"' == if pr swap '?' == if in .. sfl ] if rd swap putc go rd : pr sfl ] if pr1 zg ] putl : pr1 zg ] ( len ) + 1 + zg = go rd : po ( .. , .. at ) go rd : in ( .. fe,li defm ) go rd : ff clrm menu bend char gw( ) begin : rd stat if ff key ' ' == if rd swap '/n' == if rd swap return : ff 0 bend void mload( ger fi ) int n , ia , i0 ; def .. mema ]++ by =; begin , ( 9 , ger ] , 9 , fi ] open ) 9 #i fbegr "<>" $< ian ia = gw nif err go rd1 : rd gw nif ff : rd1 '(' == if fz swap ')' == if te swap '<' == if beg swap '>' == if rd swap '//' == if fl swap '*' == if li swap ',' == if ko swap .. '@' == if po swap '?' == if fe swap '/"' == if pr swap '.' == if ze go err : fz getz n = setfz go rd : fl getz setfl n --] if fl : te mema ] text = go rd : li 0 .. mema ] liste = : ko getz 1 + .. getz .. go rd : po getz .. getz .. go rd : pwr swap .. : pr getc '/"' <> if pwr .. go rd : ze getz .. go rd : fe getz .. ia ] = i0 ia = go rd : beg getz fbegr by = getz ( fbegr 1 + ) by = go rd : err 0 .. 9 close 0 return : ff 0 .. 9 close 1 bend char zb[ 2 , buf[ 37 ; void eg( z s n ) begin , ( z ] , s ] at ) scu ( buf , n ] edf ) swap pcu ( ' ' , n ] wputc ) buf bend void eing( ) begin 0 buf = ( 21 , 1 , 16 eg ) bend void dsuch( ) begin ( eing , ( len ) , indend ] 3 + d=such ) getds bend void sp( ) begin ( pz ] , 0 at ) swap putc bend void shf( ) int zg ; begin liste ] zg = go ns : nf ( ' ' putc izg ]] nif nfn izg ] 2 + by ] nif nfn 18 putc : nfn ) swap ( 1 - feld , zg ]++ by ] putlen ) : ns zg ]++ by ] if nf '/n' putc bend int afl ; void show( ) int szg , n ; begin 0 pz = 20 n = 147 putc izg ] szg = getds : ne shf skip+ ( getds ) swap nif ff n --] if ne : ff szg ] izg = getds afl ] nif fe menu : fe bend void sk+( ) begin sfl ] if s skip+ getds putm return : s skip+ nif ff ' ' sp pz ++] 20 == nif sn show : sn '*' sp : ff getds bend void sk-( ) int temp , n ; begin sfl ] if we skip- getds putm return : we skip- nif ff pz ] if s izg ] temp = 19 n = : r skip- n --] if r show go n2 : ne skip+ : n2 pz ]++ izg ] temp ] == nif ne : s ' ' sp pz ]-- '*' sp : ff getds bend void skv+( ) int n ; begin 20 n = : sk skip+ n --] if sk getds bend void skv-( ) int n ; begin 20 n = : sk skip- n --] if sk getds bend void zeig( ) begin sfl ] if li putm return : li show '*' sp bend void exc( ) begin sfl ] nif ff ( 0 sfl = bild getds ) swap : ff bend void res( ) begin swap sfl = bend void mark( ) begin sfl ] if we 1 sfl = zeig : we izg ]] nif we1 izg ] 2 + 1 swap xor= : we1 ( pz ] , 0 at ) shf '*' sp sk+ bend void lz( ) begin ( , 1 at ) ( ' ' , 38 wputc ) bend void setm( ) int zg , n ; begin n = izg ] zg = indan ] izg = go pr : rs izg ] 2 + n ] swap by = : pr skip+ if rs : ff zg ] izg = bend void loesch( ) begin indan ] izg = go pr : do izg ] 2 + by ] nif pr datdel 3 izg += : pr skip+ if do indan ] 3 - izg = getds bend int ja?( ) begin ( 21 , 1 at ) "wirklich j//n " putl cukey 'j' == ( ( 21 , 1 at ) ( ' ' , 12 wputc ) ) swap bend void opt( ) int opv[ 3 ; char m 24 1 "Resmark" 24 9 "Setmark" 24 17 "Loeschen/0" ; def .. == if; begin 23 lz 24 lz m menp ( opv , m mencrea ) ( opv , 3 , , 1 menw ) ( opv , 3 , , "rsl" menw ) nif ff 3 == if lo swap 1 - setm go ff : lo ja? nif ff loesch : ff ( 23 lz 24 lz ) ( menvar , 13 , , menw ) menu bend void typ( ) char ty "SEQ" "TD " "DV "; begin 4 * ty + ( 24 , 16 at ) swap putl bend char file[ 17 ; void epp( a n v t s ) int zg ; begin , a ] nif an file buf $< ian ] ifeld ] == if an swap ifeld = ineu datsort zeig : an ( 8 , 8 , 15 , bfile "s:" $< v ] $< buf $< bfile open ) 8 close ( 8 , 8 , 8 , v ] , buf , t ] open ) 8 #o n ] nif we "##" putl mema ] 1 + ( by ] ) nif we swap putl : we izg ] zg = indan ] izg = go pr : do a ] if al izg ] 2 + by ] nif pr : al s ] putl getds puts : pr skip+ if do # 8 close zg ] izg = getds bend void exp( a n ) begin , buf by ] nif ff n ] nif s 1 == if t ( a ] , n ] , "" , ",p,w" , "#" epp ) return : s ( a ] , n ] , "" , ",s,w" , "" epp ) return : t ( a ] , n ] , "d//" , ",p,w" , "*" epp ) : ff bend void ld( ) int i , n , fi ; char z '#' ; begin n = '#' z by = n ] nif s buf fi = n ] 2 == if l '*' z by = zb fi = "d//" ] zb = : l ( 8 , fi ] , mema ] 1 + load ) go ff : s ( 9 , 8 , 9 , buf open ) 9 #i mema ] 1 + izg = : ns '#' izg ]++ by = fzahl ] i = : nf ( izg ] , 0xffff getl ) izg = '/n' izg ]++ by = i --] if nf stat nif ns 9 close izg ] : ff datend = z by ] datorg bend void imp( ) int i , n , z , fi ; def zg datend; begin n = buf fi = "/0*#" n ] + by ] z = nif an '#' == if an zb fi = "d//" ] zb = : an ( 8 , 8 , 8 , fi ] open ) 8 #i z ] nif ns getc getc : ne getc stat if ff swap z ] == nif ne : af getc zg ++] by = z ] == if fe stat nif af : fe 0 zg ] by = zg ] indin stat nif af go ff : ns zg ++] fzahl ] i = : nf ( zg ] , 0xffff getl ) zg = '/n' zg ]++ by = i --] if nf 0 zg ] by = zg ] indin stat nif ns : ff 8 close getds bend int tyn 2 ; void dirget( fi ger ) int n ; def .. zg ]++ by = ; begin , int zg mema ] ; 147 putc ( fi ] , ger ] dirop ) stat nif lab1 8 close 0 return : lab1 getc getc : lab2 getc nif fertig '/"' <> if lab2 17 zg ] + n = getc getc getc '#' 0 : lab3 swap zg ]++ by = getc '/"' <> if lab3 '/n' .. zg ] n -= : lab5 getc n --] if lab5 : lab6 getc if lab6 getc getc stat nif lab1 : fertig 8 close zg ] bend void wr( ) begin ( swap ( ram ) swap ) swap ]++ by = io bend int drz ; void druck( ) int zg ; def .. zg wr; begin ( 9 , 8 , 9 , buf open ) 9 #i ( buf , 16 getl ) ram drz ] 4 + buf $< 1 + zg = stat if ff io : rd gw nif ff ( .. ) swap ( "lvfN.r" , swap inchar ) if p1 swap '/"' == if tx swap '?' == if fr swap '!' == if ru swap ':' == if p3 swap 'o' == if p2 swap ( "mn()+*" , swap inchar ) if rd io 9 close 0 return : p3 getz .. : p2 getz .. : p1 getz .. go rd : fr gw go frx : frv swap .. : frx getc '/"' <> if frv .. go p2 : tv swap .. : tx getc '/"' <> if tv .. go rd : ru getc '!' == nif rd zg ]-- '=' .. go p1 : ra swap .. getz .. go rd : ff ram 0 zg ]++ by = zg ] drz ] = 0 swap = drz ]] 2 + drz ] swap = drz ]] drz = io 9 close 1 bend int dpo , drw ; void dp( ) begin ( dpo ] , 0 at ) swap putc bend int rpl( ) int zg ; begin ] zg = go pr : wr ( io ) swap putc ram : pr zg ]++ by ] if wr zg ] bend void lpl( zg n ) begin , go prf : wr zg by ]] nif ff ( io ) swap putc ram zg ]++ go prf : ff io ' ' putc ram : prf n ]-- if wr bend int varf( ) begin 37 * 0xfc00 + bend int skm+( ) begin : pr skip+ if rs return : rs izg ] 2 + by ] nif pr bend void drucken( ) int zg , rand , var , mu , az ; def .. zg ]++ by ]; def . == if; def sw swap; begin 0 rand = 0 az = ( 4 , 3 open ) 4 #o ram drw ] 4 + ( len ) + 1 + zg = mu = : rd io wait-ready if drua ram .. nif ff '/"' . tx sw 'n' . cr sw 'v' . va sw '.' . pu sw '?' . fr sw 'r' . ra sw 'f' . fd sw '=' . al sw 'N' . cm sw 'l' . le sw '!' . au sw 'm' . mul sw '+' . sk sw '*' . sa sw '(' . ka sw ')' . kz sw ':' . wd sw 'o' . op go ff : op ( 4 , .. , .. ( io 4 close ) swap open ) 4 #o go rd : ra .. rand = go rd : au var rpl go rd : cm ( '/n' go le1 : wd ( .. go le1 : le ( ' ' : le1 , .. ( io ) swap wputc ) go rd : al ( var ] , .. lpl ) go rd : fd .. feld var = go rd : pu .. ( io ) swap putc go rd : kz skm+ nif sa getds : mn mu ] zg = go rd : ka zg ] mu = : sa indan ] izg = : sk skm+ nif ff getds go rd : va .. varf var = go rd : mul zg ] mu = io # ( 21 , 1 at ) "Multidruck: " putl 0 buf = ( 21 , 13 , 5 eg ) 21 lz buf val nif ff 1 - az = 4 #o go rd : cr io '/n' putc ( ' ' , rand ] wputc ) go rd : tx zg rpl zg = go rd : fr io # ( 23 , 1 at ) ram zg rpl zg = .. varf var = .. if fr1 buf = go fr2 : fr1 buf var ] $< : fr2 io ( 24 , 1 , 36 eg ) 4 #o ram var ] buf $< go rd : drua # ( 21 , 1 at ) "Druck fortsetzen j//n" putl cukey 'n' == ( 21 lz ) swap if fert 4 #o go rd : ff az ]-- if mn : fert io 4 close bend void drwahl( ) int zg ; begin ram drw ]] nif ff io 147 putc 0xd800 zg = go pr : wr zg ] 4 + buf swap $< zg ]] zg = io ' ' putc buf putl '/n' putc : pr ram zg ]] if wr : ne io '*' dp key 17 == if dn swap 145 == if up swap 13 == if do go ne : dn ram drw ]] nif ne ] nif ne io ' ' dp ram dpo ]++ drw ]] drw = go ne : up ram drw ] 2 + ] nif ne io ' ' dp ram dpo ]-- drw ] 2 + ] drw = go ne : do drucken : ff io 0 bend void dload( ) def .. mema ]++ by =; int tp , zg , mn[ 2 ; char m 24 1 "Anwendung" 24 11 "Typ:/0" ; begin nif anf : anfl 0 dpo = ram 0xd800 drz = drw = 0 swap = 0xd802 = io 1 sfl = 0 afl = ian = 1 setfz 20 setfl mema ] liste = 1 .. 20 .. 0 .. ( "$dv//*=s" , 8 dirget ) datend = '#' datorg izg ]] nif anf zeig : ne key 17 == if dn swap 145 == if ob swap '/n' == nif ne go an : dn sk+ go ne : ob sk- go ne : an 1 afl = 0 sfl = izg ]] rzg = ( 8 , 8 , 8 , buf "dv//" $< ( , 13 getd ) buf open ) 8 #i ( buf , 16 getl ) stat tp = # buf by ] nif err ( 8 , buf mload ) nif berr tp ] nif da mema ] 1 + datend = '#' datorg 0 file = go ff : da 8 #i ( buf , 16 getl ) stat tp = # file buf $< tyn ] ld tp ] if ff : dr 8 #i ( buf , 16 getl ) stat tp = # druck nif derr tp ] nif dr : ff 8 close bild getds zeig return : err 8 close : anf 147 putc m menp ( mn , m mencrea ) ( mn , 2 , , 1 menw ) : nex tyn ] typ ( mn , 2 , , "at" menw ) nif ne 1 == if anfl tyn ]++ 3 tyn %= go ne : derr 8 close 147 putc "Fehler in Druckmaske/n" putl end : berr 8 close 147 putc "Fehler in Bildschirmmaske/n" putl end : fert bend void disk( ) def n tyn; int div[ 7 ; char m 23 1 "Dir" 23 5 "Anwendung" 23 15 "Laden" 23 21 "Speichern" 23 31 "Import" 24 1 "Export" 24 11 "Typ:/0" ; def .. == if; def # swap; begin : an 23 lz 24 lz m menp ( div , m mencrea ) ( div , 7 , , 1 menw ) : ne n ] typ ( div , 7 , , "dalsiet" menw ) nif ff 1 .. di # 2 .. anw # 3 .. lo # 4 .. sa # 5 .. im # 6 .. ex # 7 .. ty go ff : ty n ]++ 3 n %= go ne : ex eing ( 0 , n ] exp ) go ff : anw ja? nif ff dload go ff : sa ( 21 , 1 at ) ( file , 16 putf ) 146 putc ( 21 , 1 at ) cuon : sa1 3 syscon by ] nif sa1 cuof 4 syscon by ] '/n' == if san eing go saw : san 21 lz key buf file $< : saw ( 1 , n ] exp ) go ff : di ( "$" , 8 dir ) sfl ] if di1 bild getds : di1 zeig go ff : im eing n ] imp getds zeig go ff : lo eing buf by ] nif ff file buf $< n ] ld getds zeig : ff ( 23 lz 24 lz ) ( menvar , 13 , , 7 menw ) menu bend void mlim( ) int n ; begin indend ] swap - n = 200 > if ff ( 21 , 1 at ) ( "Noch frei: %" , n ] fprint ) : ff bend void doit( ) const cup 145 cud 17 ; def . return :; def # swap; def .. == if; def (( exc (; def )) ) res; int z , gr ; begin ( menvar , 13 , , "nalsiudpevrmo" menw ( swap z = ) swap ) nif ze 1 .. neu # 2 .. ed # 3 .. lo # 4 .. su # 5 .. id # 6 .. um # 7 .. di # 8 .. pr # 9 .. ff # 10 .. vb # 11 .. rb # 12 .. ma # 13 .. op : ze z ] 17 .. vor # 145 .. rue . vor sk+ . rue sk- . vb skv+ zeig . rb skv- zeig . pr drwahl sfl ] if pr1 bild getds : pr1 zeig . su dsuch zeig . id (( neuind )) zeig . neu (( datend ] mlim clrm datan 21 lz )) zeig . ma mark . di disk . op opt zeig . lo ja? nif fe datdel getds zeig . um exc 1 xor sfl = zeig . ed datend ] gr = izg ]] nif ed1 izg ] 2 + by ] : ed1 z = (( gr ] mlim datdel datan 21 lz )) izg ] 2 + z ] swap by = zeig . ff ja? nif fe 147 putc end : fe bend main() begin ram ( 0 varf , 0 , 370 fill ) io 0 dload : ta doit go ta bend