Commodore Disc 54

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

/ Commodore Disc 54 / Commodore_Disc_54_19xx_-_de.d64 / etikett.quell < prev next >

Wrap

Text File | 2022-10-26 | 7KB | 463 lines

/* ------ Stringfunktionen ------ */ 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 /* ------- Ausgabefunktionen ------- */ 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 /* ------ Eingabefunktionen -------- */ 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 /* -------- Externe Geraete -------- */ void open( lfn ger sek liste ) def setlfs 0xffba sys; def setnam 0xffbd sys; def fopen 0xffc0 sys; int zg ; char file[ 40 ; begin , 0xffff , lfn ] ac by = ger ] xr by = sek ] yr by = setlfs sek ] not nif nam liste zg = ] not nif nam file swap : lab not $< ( 2 zg += ] ) not if lab file len : nam ac by = file 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 ]; /* -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 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 getm( 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 readm( ) 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 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 /* Eigentliches Programm */ /* Anwender-Routinen --------------- */ void eingabemaske( ) def (( putl (; def )) getm ); def cls 147 putc; begin 7 setfz 34 setfl 34 setfl 34 setfl 34 setfl 34 setfl 34 setfl 34 setfl "/147 Etikettendruck/n/n" putl fbegr "/18" $< "/n " (( 0 fe,li )) "/n " (( 1 fe,li )) "/n " (( 2 fe,li )) "/n " (( 3 fe,li )) "/n " (( 4 fe,li )) "/n " (( 5 fe,li )) "/n " (( 6 fe,li )) bend void ausdruck( ) def cr "/n"; begin cr putl ( 0 feld , cr print ) ( 1 feld , cr print ) ( 2 feld , cr print ) ( 3 feld , cr print ) ( 4 feld , cr print ) ( 5 feld , cr print ) ( 6 feld , cr print ) cr putl bend /* Programmlogik ------------------ */ main() int anz ; begin eingabemaske : neu clrm : aendern readm : menu ( 24 , 1 at ) "Neu Aendern Druck Multidruck Ende" putl key ( ( 24 , 1 at ) ( ' ' , 38 wputc ) ) swap 'n' == if neu swap 'a' == if aendern swap 'd' == if druck swap 'm' == if mdruck swap 'e' == nif menu ( 24 , 1 at ) "Wirklich beenden j//n ?" putl key ( ( 24 , 1 at ) ( ' ' , 38 wputc ) ) swap 'j' == nif menu "/n/147" putl end : mdruck ( 24 , 1 at ) "Anzahl " putl getn anz = ( 24 , 1 at ) ( ' ' , 38 wputc ) go druckprf : druck 1 anz = go druckprf : drucken ( 4 , 4 , 7 open ) 4 #o ausdruck # 4 close : druckprf anz ]-- if drucken eingabemaske putm go menu bend