{{ --------------------------------------------------------------------------------------------------------- Hive-Computer-Projekt Name : TRIOS-Basic-Runtime-Modul Chip : Regnatix-Code Version : 1.0 Dateien : Beschreibung : Basic-Runtime zum direkten ausführen von Basic-Dateien unter Plexus Eigenschaften : Logbuch : 17-05-2014 - Beginn der Schaffung eines Runtime-Moduls, um Basic-Dateien direkt aus Plexus heraus zu starten - Funktionen, wie Edit, List, direkte Befehlseingabe und sonstige Kommandofunktionen werden entfernt - Basic-Datei wird als Parameter übergeben und gestartet - Token werden nicht benötigt, da nur Binär-Dateien als Basic-Dateien erlaubt sind - erste Reinigung von unnötigen Routinen - erste funktionierende Version - 2146 Longs frei 18-05-2014 - Code weiter von unnötigen Routinen gesäubert - Fehlerabfragen und Ausgaben entfernt -> Dateien müssen fehlerfrei sein - Fehlerabfragen nur noch bei Dateihandling - 2385 Longs frei 19-05-2014 - Code weiter geschrumpft - 2416 Longs frei --------------------------------------------------------------------------------------------------------- }} obj ios :"reg-ios-bas" Fl :"FME" FS :"BasFloatString2" TMRS :"timer" gc :"glob-con" con _CLKMODE = XTAL1 + PLL16X _XINFREQ = 5_000_000 version = 1.0 fEof = $FF ' dateiende-kennung linelen = 85 ' Maximum input line length quote = 34 ' Double quote caseBit = !32 ' Uppercase/Lowercase bit point = 46 ' point STR_LEN = 34 ' Stringlänge von Stringvariablen in Arrays FIELD_LEN = 512 ' Array-Feldgröße (max Feldgröße 8x8x8 -> Dim a(7,7,7) DIR_ENTRY = 546 ' max.Anzahl mit DIR-Befehl gefundener Einträge STR_MAX = 41 ' maximale Stringlänge für Printausgaben und font DPL_CNT = 1200 ' Map-und Bildschirm-Shadow-Speicher-Zähler (40Spalten*30Zeilen=1200-Tiles) '*****************Speicherbereiche********************************************** maxstack = 20 ' Maximum stack tiefe fuer gosub userPtr = $1FFFF ' Ende Programmspeicher 128kb TMP_RAM = $20000 '....$3FFFF ' Bearbeitungsspeicher 128kb (fuer die Zeileneditierung bzw.Einfuegung von Zeilen) TILE_RAM = $40000 '....$667FF ' hier beginnt der Tile-Speicher fuer 14 Tiledateien SYS_FONT = $66800 '....$693FF ' ab hier liegt der System-Font 11kb MOUSE_RAM = $69400 '....$6943F ' User-Mouse-Pointer 64byte DIR_RAM = $69440 '....$6AFFF ' Puffer fuer Dateinamen 7103Bytes fuer 546 Dateinamen VAR_RAM = $6B000 '....$77FFF ' Variablen-Speicher fuer Array-Variablen a[0...511]-z[0...511] (13312 moegliche Variablen) MAP_RAM = $78000 '....$79C27 ' Shadow-Display (Pseudo-Kopie des Bildschirmspeichers) 'FREI_RAM $79C28 .... $79FFF ' freier RAM-Bereich 984 Bytes auch für Shadow-Display DATA_RAM = $7A000 '.... $7DFFF ' 16kB DATA-Speicher BUTT_RAM = $7E000 '.... $7E4FF ' ca.1kB Button Puffer WTILE_RAM= $7E500 '.... $7E5FF ' Win-Tile Puffer hier können die Tiles, aus denen die Fenster gebaut werden geändert werden FUNC_RAM = $7E600 '.... $7EFFF ' Funktions-Speicher, hier werden die selbstdefinierten Funktionen gespeichert ERROR_RAM = $7F000 '....$7FAFF ' ERROR-Texte DIM_VAR = $7FB00 '....$7FBFF ' Variablen-Array-Dimensionstabelle DIM_STR = $7FC00 '....$7FCFF ' String-Array-Dimensionstabelle BACK_RAM = $7FD00 '....$7FDFF ' BACKUP RAM-Bereich 256 Bytes für Ladebalken 'Frei-Ram = $7FE00 ....$7FEFF ' noch freier Bereich 256 Bytes PMARK_RAM = $7FFF0 ' Flag für Reclaim Wert= 161 BMARK_RAM = $7FFF1 ' Flag für Basic-Warm-Start Wert= 121 SMARK_RAM = $7FFF2 ' Flag für übergebenen Startparameter Wert = 222 STR_ARRAY = $80000 '....$EE7FF ' Stringarray-Speicher USER_RAM = $EE800 '....$FFEFF ' Freier Ram-Bereich, für Anwender, Backup-Funktion usw. ADM_SPEC = gc#A_FAT|gc#A_LDR|gc#A_SID|gc#A_LAN|gc#A_RTC|gc#A_PLX'%00000000_00000000_00000000_11110011 '***************** Button-Anzahl ************************************************ BUTTON_CNT = 32 'Anzahl der möglichen Button '******************Farben ******************************************************** #$FC, Light_Grey, #$A8, Grey, #$54, Dark_Grey #$C0, Light_Red, #$80, Red, #$40, Dark_Red #$30, Light_Green, #$20, Green, #$10, Dark_Green #$1F, Light_Blue, #$09, Blue, #$04, Dark_Blue #$F0, Light_Orange, #$E6, Orange, #$92, Dark_Orange #$CC, Light_Purple, #$88, Purple, #$44, Dark_Purple #$3C, Light_Teal, #$28, Teal, #$14, Dark_Teal #$FF, White, #$00, Black '*****************Tastencodes***************************************************** ENTF_KEY = 186 bspKey = $C8 ' PS/2 keyboard backspace key breakKey = $CB ' PS/2 keyboard escape key fReturn = 13 fLinefeed = 10 KEY_LEFT = 2 KEY_RIGHT = 3 KEY_UP = 4 KEY_DOWN = 5 MIN_EXP = -999999 MAX_EXP = 999999 var long sp, tp, nextlineloc, rv,{ curlineno,} pauseTime 'Goto,Gosub-Zähler,Kommandozeile,Zeilenadresse,Random-Zahl,aktuelle Zeilennummer, Pausezeit long stack[maxstack],speicheranfang,speicherende 'Gosub,Goto-Puffer,Startadresse-und Endadresse des Basic-Programms long forStep[26], forLimit[26], forLoop[26] 'Puffer für For-Next Schleifen long prm[10] 'Befehlszeilen-Parameter-Feld (hier werden die Parameter der einzelnen Befehle eingelesen) long gototemp,gotobuffer,gosubtemp,gosubbuffer 'Gotopuffer um zu verhindern das bei Schleifen immer der Gesamte Programmspeicher nach der Zeilennummer durchsucht werden muss long datapointer 'aktueller Datapointer long restorepointer 'Zeiger für den Beginn des aktuellen DATA-Bereiches long num1,num2 'Puffer für mathematische Funktionen long usermarker,basicmarker 'Dir-Marker-Puffer für Datei-und Verzeichnis-Operationen word tilecounter 'Zaehler fuer Anzahl der Tiles in einer Map word filenumber 'Anzahl der mit Dir gefundenen Dateien word var_arr[3] 'temp array speicher varis-funktion für direkten Zugriff word var_tmp[3] 'temp array speicher varis-funktion für zweite Variable (in pri factor) um Rechenoperationen u.a. auszuführen word var_temp[3] 'temp array speicher erst mit dem dritten Speicher funktioniert die Arrayverwaltung korrekt byte workdir[12] 'aktuelles Verzeichnis byte fileOpened,tline[linelen] 'File-Open-Marker,Eingabezeilen-Puffer byte cursor 'cursor on/off byte win 'Fensternummer byte farbe,hintergr,cursorcolor 'vorder,hintergrundfarbe und cursorfarbe byte file1[12],dzeilen,buff[8],modus 'Dir-Befehl-variablen extension[12] byte volume,play 'sidcog-variablen byte xtiles[16] 'xtiles fuer tilenr der Tile-Dateien ' byte ytiles[16] 'ytiles fuer tilenr der Tile-Dateien byte str0[STR_MAX],strtmp[STR_MAX] 'String fuer Fontfunktion in Fenstern byte aktuellestileset 'nummer des aktuellen tilesets byte font[STR_MAX] 'Stringpuffer fuer Font-Funktion und str$-funktion byte mapram 'Map-Schreibmarker byte math[8] 'Funktionsstring für mathematische funktionen byte ongosub 'on gosub variable byte serial 'marker für serielle schnittstelle 1=geöffnet 0=geschlossen byte actionkey[5] 'Belegung der Spielertasten -> nach Bella verschoben byte item[6] 'von Spielerfigur einsammelbare Gegenstände byte block[10] 'tiles, die nicht überquert werden können byte collision[6] 'tiles mit denen man kollidieren kann byte itemersatz[30] 'Item-Ersatztiles, die das eingesammelte item im Display-Ram und auf dem Bildschirm ersetzen byte f0[STR_MAX] 'Hilfsstring byte ADDA,PORT 'Puffer der Portadressen der Sepia-Karte byte returnmarker 'Abbruchmarker für Zeileneditor byte actorpos[2] 'Zwischenspeicher für x,y-Position des Spieler-Tiles byte button_art[BUTTON_CNT] 'Puffer für die Art des Buttons (Text-oder Icon) byte sid_command[7] 'SID-Sound-Kommando DAT '***************** mathematische Funktionen ************************ mtok1 byte "SIN",0 'Sinus # mtok2 byte "COS",0 'Cosinus # mtok3 byte "TAN",0 'Tangens # mtok4 byte "LN",0 'natürlicher logarythmus # mtok5 byte "E",0 'e-funkt # mtok6 byte "INT",0 'Integerwert von x mtok7 byte "LOG",0 'Logarythmus zur Basis 10 # mtok8 byte "ATAN",0 'Arcustangens # mtok9 byte "PREC",0 'Genauigkeit setzen (1-7) mtok10 byte "SGN",0 'Signum-Funktion (sgn(8)=1, sgn(0)=0,sgn(-8)=-1) '*********** Bit-Operationen **************************************** mtok11 byte "SHL",0 'Shift left mtok12 byte "SHR",0 'Shift right mtok13 byte "REV",0 'Revers mtok14 byte "ODER",0 'Bitwise OR mtok15 byte "XODER",0 'Bitwise XOR mtok16 byte "UND",0 'Bitwise And '*********** zusätzliche Funktionen ********************************* mtok17 byte "ASIN",0 'arcus Sinus mtok18 byte "ACOS",0 'arcus Cosinus mtoks word @mtok1,@mtok2,@mtok3,@mtok4,@mtok5,@mtok6,@mtok7 word @mtok8,@mtok9,@mtok10,@mtok11,@mtok12,@mtok13 word @mtok14,@mtok15,@mtok16,@mtok17,@mtok18 DAT '*************** Sound-Funktionen ********************************** stok0 byte "NT",0 'Note an/aus stok1 byte "VOL",0 'Lautstärke 0-15 stok2 byte "ADSR",0 'Lautstärke-Hüllkurve stok3 byte "WAVE",0 'Wellenform stok4 byte "FLT",0 'Filtertyp stok5 byte "FMASK",0 'Filtermaske stok6 byte "RMOD",0 'Ringmodulator stok7 byte "CUTRES",0'Cutoff und Resonanz stok8 byte "PWM",0 'PWM-Wert stok9 byte "SYNC",0 'Oszillatorsynchronisation stoks word @stok0,@stok1,@stok2,@stok3,@stok4,@stok5,@stok6,@stok7,@stok8,@stok9 Dat 'direkte mathematische Funktionen ' ^ - y^x (entspricht y*y x-mal) # ' // - Modulo # ' ! - Absolutwert von x ' - Negativwert von x ' + - * / Grundrechenarten ' √ - Wurzel # ' π - Kreiszahl PI # DAT ext5 byte "*.*",0 'alle Dateien anzeigen tile byte "Tile",0 'tile-Verzeichnis sysfont byte "sysfontb.dat",0 'system-font windowtile byte 135,137,136,126,141,134,132,130,128,124,129,133,0,131,124,124,124 'Fenster-Tiles für WIN-Funktion con'****************************************** Hauptprogramm-Schleife ************************************************************************************************************* PUB main | sa init 'Startinitialisierung sa := 0 'startparameter 'curlineno := -1 'startparameter repeat \doline(sa) 'eine kommandozeile verarbeiten sa := 0 'Zeile verwerfen da abgearbeitet con'****************************************** Initialisierung ********************************************************************************************************************* PRI init '|pmark,newmark,x,y,i ios.start basicmarker:= get_dirmarker 'usermarker von administra holen usermarker:=basicmarker '************************************************************************************************************************************************************** FS.SetPrecision(6) 'Präzision der Fliesskomma-Arithmetik setzen '*********************************** Timer-Cog starten ******************************************************************************************************** TMRS.start(10) 'Timer-Objekt starten mit 100ms-Aufloesung '************************************************************************************************************************************************************** '*********************************** Startparameter *********************************************************************************************************** pauseTime := 0 'pause wert auf 0 fileOpened := 0 'keine datei geoeffnet volume:=15 'sid-cog auf volle lautstaerke speicheranfang:=$0 'Programmspeicher beginnt ab adresse 0 im eRam speicherende:=$2 'Programmende-marke mapram:=0 'Map-Schreibmarker auf 0 farbe:=black 'Schreibfarbe hintergr:=white 'Hintergrundfarbe cursorcolor:=grey 'Farbe des Cursors '*************** Bildschirmaufbau *********************************** mount ios.window(0,farbe,hintergr,cursorcolor,0,0,0,0,0,0,0,29,39,1,0) ios.printchar(12) 'cls LoadTiletoRam(15,@sysfont,16,11) 'Logo und Font in eram laden loadtile(15) 'Logo und Font in den Puffer laden Win_Set_Tiles 'Fenster Tile-Nummern in den Ram schreiben ios.displaymouse(0,0) 'Maus abschalten, falls an win:=0 'aktuelle fensternummer 0 ist das Hauptfenster cursor:=0 'cursormarker für Cursor on ios.sid_resetregisters 'SID Reset dzeilen:=9 modus :=2 'Modus1=compact, 2=lang 0=unsichtbar serial:=0 'serielle Schnittstelle geschlossen ios.setactionkey(2,3,4,5,32) 'Cursorsteuerung-Standardbelegung actionkey[0]:=2 'links actionkey[1]:=3 'rechts actionkey[2]:=4 'hoch actionkey[3]:=5 'runter actionkey[4]:=32 'feuer ADDA:=$48 'Portadressen und AD-Adresse für Sepia-Karte vorbelegen PORT:=$20 ios.set_plxAdr(ADDA,PORT) read_filename clearvars ios.clearkey obj '************************** Datei-Unterprogramme ****************************************************************************************************************************** con '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ PRI ifexist(dateiname) 'abfrage,ob datei schon vorhanden, wenn ja Überschreiben-Sicherheitsabfrage ios.printnl mount if ios.sdopen("W",dateiname)==0 'existiert die dateischon? ios.print(string("File exist! Overwrite? y/n")) 'fragen, ob ueberschreiben if ios.keywait=="y" if ios.sddel(dateiname) 'wenn ja, alte Datei loeschen, bei nein ueberspringen close return 0 ios.sdnewfile(dateiname) ios.sdopen("W",dateiname) else ios.printnl return 2 'datei nicht ueberschreiben else 'wenn die Datei noch nicht existiert if ios.sdnewfile(dateiname) close return 0 ios.sdopen("W",dateiname) ios.printnl return 1 PRI close ios.sdclose ios.sdunmount PRI mount playerstatus ios.sdmount activate_dirmarker(usermarker) if strsize(@workdir)>1 ios.sdchdir(@workdir) usermarker:=get_dirmarker con '********************************** Speicher und Laderoutinen der Basic-Programme als Binaerdateien, ist erheblich schneller ************************* pri binsave|datadresse,count datadresse:= 0 count:=speicherende-2 ios.sdxputblk(datadresse,count) close PRI binload(adr)|count count:=fileload(adr) writeendekennung (adr+count) RAM_CLEAR PRI RAM_CLEAR ios.ram_fill(speicherende,$20000-speicherende,0) 'Programmspeicher hinter dem Programm loeschen con '********************************** Fehler-und System-Texte in den eRam laden **************************************************************************************************************** PRI fileload(adr): cont cont:=ios.sdfattrib(0) 'Anzahl der in der Datei existierenden Zeichen ios.sdxgetblk(adr,cont) close PRI errortext'|ad 'Fehlertext anzeigen ios.print(string("ERROR")) 'fehlertext sysbeep Prg_End_Pos close abort PRI sysbeep ios.sid_dmpstop ios.sid_beep(0) con '************************************* Basic beenden ************************************************************************************************************************** PRI ende 'ios.print("BYE!!!") ios.ram_wrbyte(0,SMARK_RAM) 'Start-Parameter-Flag löschen TMRS.stop mount ios.stop con'**************************************** Basic-Zeile aus dem Speicher lesen und zur Abarbeitung uebergeben ******************************************************************** PRI doline(s) | i 'curlineno := -1 'erste Zeile i:=0 ios.key 'diese Funktion nicht entfernen 'sonst funktioniert Inkey nicht, keine Ahnung warum if nextlineloc < speicherende-2 'programm abarbeiten '*******************Zeile aus eram holen********************************************* nextlineloc+=2 repeat while tline[i++]:=ios.ram_rdbyte(nextlineloc++) tline[i]:=0 tp:= @tline texec 'befehl abarbeiten else pauseTime := 0 'oder eingabezeile returnmarker:=0 ios.print(string("OK>")) 'Promt ausgeben getline(0) 'Zeile lesen und con'************************************* Basic-Zeile uebernehmen und Statustasten abfragen *************************************************************************************** PRI getline(laenge):e | i,f, c 'zeile eingeben i := laenge f:=laenge e:=0 repeat '********************* Playerstatus abfragen, wenn er laeuft und am ende des Titels stoppen und SD-Card freigeben******************************** if play:=1 and ios.sid_dmppos<20 'Player nach abgespielten Titel stoppen playerstatus '************************************************************************************************************************************************ c := ios.keywait case c 008:if i > 0 'bei backspace ein zeichen zurueck 'solange wie ein zeichen da ist ios.printbs 'funktion ausfueren backspace i-- 'nochmal laenge:=i 'laenge ist immer die aktuelle laenge der zeile 002:if i>0 'Pfeiltaste links ios.printleft i-- 003:ios.printright 'Pfeiltaste rechts i++ 004:repeat while ilaenge laenge:=i 'laenge ist immer die aktuelle laenge der zeile con '*********************************** Routinen zur Programmzeilenverwaltung im E-Ram******************************************************************************************** PRI writeendekennung(adr) ios.ram_wrword($FFFF,adr) 'Programmendekennung schreiben speicherende:=adr+2 'neues Speicherende PRI Prg_End_Pos 'letztes Zeichen der letzten Zeile (Programmende) nextlineloc := speicherende - 2 PRI findline(lineno):at at := speicheranfang repeat while ios.ram_rdword(at) < lineno and at < speicherende-2 'Zeilennummer at:=ios.ram_keep(at+2)'+1 'zur nächsten zeile springen con '******************************** Variablenspeicher-Routinen ****************************************************************************************************************** PRI clearvars clearing nextlineloc := speicheranfang 'Programmadresse auf Anfang sp := 0 clearstr 'Stringpuffer löschen PRI clearing |i ios.ram_fill(DIR_RAM,$15BBF,0)'$EBBF,0) 'Variablen,Dir-Speicher,Map-Speicher-Shadow-Bildschirmspeicher bis $79C27 loeschen beginnend mit dem Dir-Speicher ios.ram_fill(STR_ARRAY,$6E800,0) 'Stringarray-Speicher loeschen ios.ram_fill(DIM_VAR,$1FF,0) 'DIM-Speicher löschen repeat i from 0 to 25 'DIM Speicher vorbelegen ios.ram_wrword(10,DIM_STR+(2*i*3)) ios.ram_wrword(10,DIM_VAR+(2*i*3)) pauseTime := 0 gototemp:=gosubtemp :=0 'goto-Puffer loeschen gotobuffer:=gosubbuffer:=0 restorepointer:=0 'Restore-Zeiger löschen datapointer:=0 'Data-Zeiger löschen ios.serclose 'serielle Schnittstelle schliessen serial:=0 DATA_POKE(1,0) 'erste Data-Zeile suchen, falls vorhanden if restorepointer 'DATA-Zeilen vorhanden DATA_POKE(0,restorepointer) 'Datazeilen in den E-Ram schreiben PRI newprog speicherende := speicheranfang + 2 nextlineloc := speicheranfang writeendekennung(speicheranfang) sp := 0 'stack loeschen PRI clearall newprog clearvars PRI pushstack 'Gosub-Tiefe max. 20 stack[sp++] := nextlineloc 'Zeile merken PRI varis(var_name,wert,rw,x,y,z)|adress,c 'Arrayverwaltung im eRam (Ram_Start_Adresse,Buchstabe, Wert, lesen oder schreiben,Arraytiefenwert 0-255) adress:=vari_adr(var_name,x,y,z) if rw==0 c:=ios.ram_rdlong(adress) 'Array lesen return c else ios.ram_wrlong(wert,adress) 'Array schreiben pri vari_adr(n,x,y,z):adress|ad 'adresse der numerischen Variablen im Ram ad:=DIM_VAR+(2*n*3) adress:=scandimension(VAR_RAM,4,n,x,y,z,ios.ram_rdword(ad),ios.ram_rdword(ad+2),ios.ram_rdword(ad+4)) PRI klammers 'Arraydimensionen lesen (bis zu 3 Dimensionen) wordfill(@var_arr,0,3) if spaces=="(" tp++ var_arr[0]:=get_array_value var_arr[1]:=wennkomma var_arr[2]:=wennkomma klammerzu PRI wennkomma:b if spaces=="," tp++ b:=get_array_value PRI get_array_value|tok,c 'Array-Koordinaten lesen und zurückgeben tok := spaces 'Zeichen lesen tp++ 'ein Zeichen weiter case tok "a".."z","A".."Z": 'Wert von Variablen a-z c:=varis(fixvar(tok),0,0,0,0,0) 'pos,wert,r/w,x,y,z return fl.ftrunc(c) 'und zurueckgeben "$","%","0".."9": 'Zahlenwerte --tp return fl.ftrunc(getAnyNumber) obj '******************************************STRINGS***************************************************************************************************************************** con '************************************* Stringverarbeitung ********************************************************************************************************************* Pri Input_String tp-- getstr bytemove(@f0,@font,strsize(@font)) 'string nach f0 kopieren PRI getarray :adresswert|a,b,c,d,ad 'Stringarray-Dimensionen lesen und Adresse im Ram berechnen a:=spaces tp++ b:=0 c:=0 d:=0 if spaces=="(" tp++ b:=expr(1) c:=wennkomma d:=wennkomma klammerzu if isvar(a) a:=fixvar(a) ad:=DIM_STR+(2*a*3) 'x-Dimension y-Dimension z-Dimension aus Dimensionsspeicher lesen adresswert:=scandimension(STR_ARRAY,STR_LEN,a,b,c,d,ios.ram_rdword(ad),ios.ram_rdword(ad+2),ios.ram_rdword(ad+4)) PRI scandimension(startpos,laenge,varib,x,y,z,varx,vary,varz) : Position 'Überprüfung auf Dimensionswerte und Feldpositionsberechnung 'Feldposition im Ram y-Position x-Position z-Position Position:=startpos+(laenge*varib*FIELD_LEN)+(varx*y*laenge)+(x*laenge)+(varx*vary*laenge*z) PRI clearstr bytefill(@font,0,STR_MAX) bytefill(@str0,0,STR_MAX) '*********************************************************************************************************************************************************** PRI getstr:a|nt,b,str 'string in Anführungszeichen oder Array-String einlesen a:=0 skipspaces nt:=spaces bytefill(@font,0,STR_MAX) case nt quote: scanfilename(@font,0,quote) 'Zeichenkette in Anführungszeichen "#": 'String-Array skipspaces a:=getarray 'Stringarray lesen stringlesen(a) 176: skipspaces 'Chr$-Funktion a:=klammer byte[@font][0]:=a byte[@font][1]:=0 236: stringwiederholung 'String$-Funktion 245: skipspaces Bus_Funktionen 'Stringrückgabe von XBUS-Funktion 163: skipspaces 'STR$-Funktionen left,mid,right stringfunc2 "a".."z","A".."Z": 'konvertiert eine Variable a(0..255)-z(0..255) in einen String skipspaces klammers b:=varis(fixvar(nt),0,0,var_arr[0],var_arr[1],var_arr[2]) 'Arrayvariable aus eRam holen str:=zahlenformat(b) bytemove(@font,str,strsize(str)) '*********************************************************************************************************************************************************** PRI stringfunc(pr) | a7,identifier 'stringfunktion auswaehlen identifier:=0 if pr>0 'Stringzuweisung skipspaces a7:=getarray 'String-Array, der mit der Funktion gefüllt werden soll if spaces=="=" getstr 'welche Funktion soll ausgeführt werden? else 'Stringausgabe mit Print tp-- getstr 'welche Funktion soll ausgeführt werden? bytemove(@str0,@font,strsize(@font)) identifier:=spaces 'welche Funktion kommt jetzt? if identifier>0 stringfunktionen(a7,identifier,pr) else 'keine Funktion dann stringschreiben(a7,0,@str0,pr,0)-1 'String schreiben PRI stringfunktionen(a,identifier,pr) 'Strings addieren repeat while identifier if identifier==43 '************* funktioniert ****************** '+ Zeichen Strings addieren getstr bytemove(@str0[strsize(@str0)],@font,strsize(@font)) 'verschiebe den String in den Schreibstring-Puffer else stringschreiben(a,0,@str0,pr,0)-1 'andere Zeichen als "+" zBsp Ausgabe des Strings mit PRINT string,string;variable return identifier:=spaces 'weitere Zeichen? wenn ja dann von vorn stringschreiben(a,0,@str0,pr,0)-1 'keine Zeichen mehr String schreiben PRI stringwiederholung|a,b 'String$-Funktion skipspaces klammerauf a:=expr(1) 'anzahl wiederholungen komma tp-- getstr klammerzu bytefill(@strtmp,0,STR_MAX) 'Stringpuffer löschen bytemove(@strtmp,@font,strsize(@font)) 'String, der wiederholt werden soll merken bytefill(@font,0,STR_MAX) 'Stringpuffer löschen b:=0 repeat a if b>STR_MAX byte [@font][STR_MAX-1]:=0 quit bytemove(@font[b],@strtmp,strsize(@strtmp)) 'Anzahl a Wiederholungen in Stringpuffer schreiben b:=strsize(@font) PRI stringfunc2|a8,b8,c8,function,a,b 'die Stringfunktionen (left, right, mid) function:=spaces skipspaces klammerauf tp-- getstr ' String holen case function "l","L","m","M","r","R": a8:=strsize(@font) komma b8:=expr(1) 'anzahl zeichen fuer stringoperation if function==77 or function==109 'midstr komma c8:=expr(1) klammerzu case function "l","L":a:=0 b:=b8 "m","M":a:=b8-1 b:=c8 "r","R":a:=a8-b8 b:=b8 "u","U":charactersUpperLower(@font,0) 'in Grossbuchstaben umwandeln return "d","D":charactersUpperLower(@font,1) 'in Kleinbuchstaben umwandeln return bytemove(@font,@font[a],b) byte[@font][b]:=0 PRI charactersUpperLower(characters,mode) '' 4 Stack Longs '' ┌───────────────────────────────────────────────────────────────────────────┐ '' │ Wandelt die Buchstaben in Groß (mode=0) oder Klein(mode=1) um. │ '' └───────────────────────────────────────────────────────────────────────────┘ repeat strsize(characters--) result := byte[++characters] if mode if((result > 64) and (result < 91)) 'nur A -Z in Kleinbuchstaben byte[characters] := (result + 32) else if(result > 96) 'nur a-z in Großbuchstaben byte[characters] := (result - 32) PRI stringlesen(num) | p,i i:=0 repeat while p:=read_ram(num++) 'string aus eram lesen und in @font schreiben byte[@font][i++]:=p byte[@font][i]:=0 return num PRI stringschreiben(adre,chr,strkette,pr,data) | c9,zaehler,laenge zaehler:=0 if data==0 'keine Data-Zeile laenge:=STR_LEN-1 else 'Data-Zeile laenge:=linelen case pr 0:if chr>0 ios.printchar(chr) else ios.print(strkette) 1:if chr==0 repeat strsize(strkette) zaehler++ c9:= byte[strkette++] if zaehler= strsize(strAddr) if (strcomp(substr(strAddr, offset++, searchsize), searchAddr)) 'if string search found return offset return 0 PUB substr (strAddr, start, count) 'gibt einen Teilstring zurück von start mit der Anzahl Zeichen count bytefill(@strtmp, 0, STR_MAX) bytemove(@strtmp, strAddr + start, count) 'just move the selected section return @strtmp obj '*********************************************** TIMER-FUNKTIONEN *********************************************************************************************************** con' *********************************************** Verwaltung der acht Timer ************************************************************************************************** PRI timerfunction:b|a,c,function function:=spaces skipspaces case function 'Timerfunktionen mit Werterueckgabe "c","C":'isclear? 'Timer abgelaufen? a:=klammer'expr return TMRS.isclr(a-1) "r","R":'read 'Timerstand abfragen a:=klammer'expr return TMRS.read(a-1) 'Timer 1-12 lesen "s","S":'timerset 'Timer 1-12 setzen klammerauf a:=expr(1) komma c:=expr(1) klammerzu TMRS.set(a-1,c) con '********************************* Befehle, welche mit Printausgaben arbeiten ************************************************************************************************* PRI factor | tok, a,b,c,d,e,g,f,fnum 'Hier werden nur Befehle ohne Parameter behandelt tok := spaces e:=0 tp++ case tok "(": a := expr(0) if spaces <> ")" errortext tp++ return a "a".."z","A".."Z": klammers'factor wordmove(@var_tmp,@var_arr,3) c:=varis(fixvar(tok),0,0,var_tmp[0],var_tmp[1],var_tmp[2]) 'pos,wert,r/w,x,y,z return c 'und zurueckgeben 152:'GFile 'Ausgabe Anzahl, mit Dir-Filter gefundener Dateieintraege ifnot spaces return fl.ffloat(filenumber) 160:'gdmp playerposition return fl.ffloat(ios.sid_dmppos) 164:'COMP$ klammerauf Input_String bytemove(@str0,@f0,strsize(@f0)) 'in 2.Puffer merken komma Input_String c:=strcomp(@str0,@f0) 'beide vergleichen -1=gleich 0=ungleich klammerzu return fl.ffloat(c) 165:'LEN klammerauf Input_String a:=strsize(@f0) klammerzu return fl.ffloat(a) 167:'Window return fl.ffloat(ios.get_window) 177:'FREE return fl.ffloat(userptr-speicherende) 182: ' FILE return fl.ffloat(ios.sdgetc) 183:'JOY a:=klammer return fl.ffloat(ios.Joy(3+a)) 204:'gtime a:=klammer return fl.ffloat(lookup(a:ios.getHours,ios.getMinutes,ios.getSeconds)) 205:'gdate a:=klammer return fl.ffloat(lookup(a:ios.getDate,ios.getMonth,ios.getYear,ios.getday)) 207: 'Port return fl.ffloat(Port_Funktionen) 211:'FUNC a:=spaces if isvar(a) a:=fixvar(a) 'Funktionsvariable c:=FUNC_RAM+(a*56) 'Adresse der Funktion im E-Ram skipspaces klammerauf b:=expr(0) 'Operandenwert der Operandenvariablen d:=ios.ram_rdlong(c) 'Adresse der Operandenvariablen aus Funktionsram lesen ios.ram_wrlong(b,d) 'Operandenwert an die Adresse der Operanden-Variablen schreiben g:=c repeat 3 g+=4 f:=ios.ram_rdlong(g) 'Adresse des nächsten Operanden if spaces=="," skipspaces e:=expr(0) 'nächster Variablenwert if f=>VAR_RAM 'Variable nicht null, also vorhanden ios.ram_wrlong(e,f) 'Variablenwert schreiben, wenn vorhanden else quit klammerzu stringlesen(c+16) 'Funktionszeile aus dem E-Ram lesen und nach @font schreiben tp := @font 'Zeile nach tp übergeben d:=expr(0) 'Funktion ausführen return d 'berechneter Wert wird zurückgegeben 212:'inkey return fl.ffloat(ios.inkey) 215:'PEEK a:=expr(1) 'adresse komma b:=expr(1) '1-byte, 2-word, 4-long return fl.ffloat(lookup(b:read_ram(a),ios.ram_rdword(a),0,ios.ram_rdlong(a))) 219:'Player c:=expr(1) if c==1 a:=Kollisionserkennung if a==0 a:=ios.get_collision else a:=Item_sammeln return fl.ffloat(a) 221:'MGET b:=klammer return fl.ffloat(lookup(b:ios.mousex,ios.mousey,ios.mousez)) ' 222: return fl.ffloat(LAN_Function) 225:'MB a:=klammer b:=ios.mouse_button(a) if b>0 and b a:=klammer a*=1000 b:=((rv? >>1)**(a<<1)) b:=fl.ffloat(b) return fl.fmul(fl.fdiv(b,fl.ffloat(10000)),fl.ffloat(10)) "-": return fl.FNeg(factor) 'negativwert ->factor, nicht expr(0) verwenden "!": return fl.FAbs(factor) 'Absolutwert ->factor, nicht expr(0) verwenden "√": klammerauf a:=expr(0) klammerzu return fl.fsqr(a) 'Wurzel "π":'PI 'Kreiszahl Pi ausgeben return pi "$","%", quote,"0".."9": --tp return getAnyNumber Con '******************************************* Operatoren ********************************************************************************************************************* PRI bitTerm | tok, t t := Factor repeat tok := spaces if tok == "^" 'Power y^x y hoch x entspricht y*y (x-mal) tp++ t := fl.pow(t,factor) else return t PRI term | tok, t,a t := bitTerm repeat tok := spaces if tok == "*" tp++ t := fl.FMUL(t,bitTerm) 'Multiplikation elseif tok == "/" if byte[++tp] == "/" tp++ t := fl.FMOD(t,bitTerm) 'Modulo else a:=bitTerm if a<>0 t :=fl.FDIV(t,a) 'Division else return t PRI arithExpr | tok, t t := term repeat tok := spaces if tok == "+" tp++ t := fl.FADD(t,term) 'Addition elseif tok == "-" tp++ t := fl.FSUB(t,term) 'Subtraktion else return t PRI compare | op,a,c a := arithExpr op := 0 spaces repeat c := byte[tp] case c "<": op |= 1 tp++ ">": op |= 2 tp++ "=": op |= 4 tp++ other: quit case op 0: return a 1: return a arithExpr 3: return a <> arithExpr 4: return a == arithExpr 5: return a =< arithExpr 6: return a => arithExpr PRI logicNot | tok tok := spaces if tok == 149 ' NOT tp++ return not compare return compare PRI logicAnd | t, tok t := logicNot repeat tok := spaces if tok == 150 ' AND tp++ t := t and logicNot else return t PRI expr(mode) | tok, t t := logicAnd repeat tok := spaces if tok == 151 ' OR tp++ t := t or logicAnd else if mode==1 'Mode1, wenn eine Integerzahl gebraucht wird t:=fl.FTrunc(t) return t PRI SID_SOUND|i,err,a,b i:=0 err:=1 scanfilename(@sid_command,1,40) tp-- klammerauf repeat 10 if strcomp(@sid_command,@@stoks[i++]) err:=0 quit case i 1:'NT param(1) a:=prm[0] b:=prm[1] if b ios.sid1_noteon(a,b) else ios.sid1_noteOff(a) 2:a:=expr(1) a&=15 volume:=a ios.sid1_setVolume(volume) 3:'ADSR param(4) ios.sid1_setADSR(prm[0],prm[1],prm[2],prm[3],prm[4]) ios.sid_beep(1) 4:'WAVE a:=expr(1) komma b:=expr(1) b+=3 b:=1<7 errortext FS.SetPrecision(num1) 10:num1:=expr(0) 'SGN-Funktion + if num1>0 result:=1 elseif num1==0 result:=0 elseif num1<0 result:=-1 result:=fl.ffloat(result) 11:Get_term(1) 'shift left + result:=fl.ffloat(num1<>num2) 13:Get_Term(1) 'reverse result:=fl.ffloat(num1> kennung if chars++ < STR_MAX 'Wert stringlänge ist wegen Stringfunktionen if mode==1 'im Modus 1 werden die Buchstaben in Grossbuchstanben umgewandelt if c>96 c^=32 byte[f++] := c byte[f] := 0 con '************************************ einlesen der Arrays für INPUT und FREAD ************************************************************************************************ pri Get_Input_Read(anz):b |nt 'Eingabe von gemischten Arrays für INPUT und FREAD b:=0 nt:=spaces repeat '***************** Zahlen *************************************** if isvar(nt) skipspaces klammers prm[b++]:=vari_adr(fixvar(nt),var_arr[0],var_arr[1],var_arr[2]) if spaces=="," nt:=skipspaces else quit if anz==b quit '*************** Strings **************************************** elseif nt=="#" skipspaces prm[b++]:=getarray if spaces=="," nt:=skipspaces else quit con '***************************************** Befehlsabarbeitung **************************************************************************************************************** PRI texec | ht, nt, restart,a,b,c,d,e,f,h,elsa bytefill(@f0,0,STR_MAX) restart := 1 a:=0 b:=0 c:=0 repeat while restart restart := 0 ht := spaces if ht == 0 return if ht=="#" stringfunc(1) return skipspaces if isvar(ht) 'Variable? dann arrayfeld einlesen klammers wordmove(@var_temp,@var_arr,3) 'kopie des Arrayfeldes nt := spaces if isvar(ht) and nt == "=" tp++ varis(fixvar(ht),expr(0),1,var_temp[0],var_temp[1],var_temp[2]) elseif ht => 128 case ht 128: 'IF THEN ELSE a := expr(0) elsa:=0 'else-marker loeschen -> neue if then zeile if spaces <> 129 'errortext skipspaces if not a 'Bedingung nicht erfuellt dann else marker setzen elsa:=1 return restart := 1 238:'ELSE if elsa==1 elsa:=0 restart := 1 130: ' INPUT {"";} {, } if is_string input_string if spaces <> ";" 'errortext '@syn nt := skipspaces ios.print(@f0) b:=Get_Input_READ(9) if getline(0)==0 and strsize(@tline)>0 'nur weitermachen, wenn nicht esc-gedrückt wurde und die Eingabezeile größer null war FILL_ARRAY(b,0) 'Daten in die entsprechenden Arrays schreiben 131: ' PRINT a := 0 repeat nt := spaces if nt ==0 or nt==":" quit case nt "#",163,176,236,245,quote:stringfunc(0) 'Strings 184:skipspaces 'TAB a:=klammer ios.setx(a) 250,248:skipspaces a:=klammer d:=a c:=1 'Hex-Ausgabe Standard 1 Stelle e:=4 'Bin-Ausgabe Standard 4 Stellen repeat while (b:=d/16)>0 'Anzahl Stellen für Ausgabe berechnen c++ e+=4 d:=b if nt==250 ios.printhex(a,c) 'Hex if nt==248 ios.printbin(a,e) 'Bin 233:skipspaces 'ASC klammerauf if spaces==quote skipspaces 'Anfuehrungszeichen ueberspringen ios.printdec(spaces) 'ASCII-Wert ausgeben repeat while skipspaces<>quote 'weiterspringen bis Anfuerungszeichen skipspaces 'Anfuehrungszeichen ueberspringen elseif raute a:=getarray ios.printdec(read_ram(a)) klammerzu other: ios.print(zahlenformat(expr(0))) nt := spaces case nt ";": tp++ ",": a:=ios.getx ios.setx(a+8) tp++ ":",0:ios.printchar(fReturn) quit other:ios.printchar(nt) 216: 'ON Gosub,Goto ongosub:=0 ongosub:=expr(1) if spaces < 132 or spaces >133 'kein goto oder gosub danach 'errortext if not ongosub 'on 0 gosub wird ignoriert (Nullwerte werden nicht verwendet) return restart := 1 132, 133: ' GOTO, GOSUB e:=0 a:=expr(1) if ongosub>0 e:=1 repeat while spaces=="," and ea 'sonst zeilennummer merken fuer naechsten durchlauf gotobuffer:=findline(a) 'adresse merken fuer naechsten durchlauf gototemp:=a if ht==133 pushstack nextlineloc := gotobuffer '*************************************************************************************************************************************************************** 134: ' RETURN nextlineloc := stack[--sp] 135,168: ' REM,DATA repeat while skipspaces 136: ' NEW ios.ram_fill(0,$20000,0) clearall 137: ' LIST { {,}} 'List in Runtime nicht erlaubt 'Listout 138: ' RUN clearvars 'alle variablen loeschen ios.clearkey 'Tastaturpuffer löschen 140: ' OPEN " ", R/W/A Input_String if spaces <> "," 'Errortext '@syn d:=skipspaces tp++ mount if ios.sdopen(d,@f0) errortext fileOpened := true 141: 'FREAD {, } b:=Get_Input_Read(9) repeat 'Zeile von SD-Karte in tline einlesen c := ios.sdgetc if c < 0 errortext 'Dateifehler elseif c == fReturn or c == ios.sdeof 'Zeile oder Datei zu ende? tline[a] := 0 'tline-String mit Nullbyte abschliessen tp := @tline 'tline an tp übergeben quit elseif c == fLinefeed 'Linefeed ignorieren next elseif a < linelen-1 'Zeile kleiner als maximale Zeilenlänge? tline[a++] := c 'Zeichen in tline schreiben Fill_Array(b,0) 'Daten in die entsprechenden Arrays schreiben 142: ' WRITE ... b:=0 'Marker zur Zeichenketten-Unterscheidung (String, Zahl) repeat nt := spaces 'Zeichen lesen if nt == 0 or nt == ":" 'raus, wenn kein Zeichen mehr da ist oder Doppelpunkt auftaucht quit if is_string 'handelt es sich um einen String? input_string 'String einlesen b:=1 'es ist ein String stringschreiben(0,0,@font,2,0) 'Strings schreiben elseif b==0 'kein String, dann eine Zahl stringschreiben(0,0,zahlenformat(expr(0)),2,0) 'Zahlenwerte schreiben nt := spaces case nt ";": tp++ 'Semikolon bewirkt, das keine Leerzeichen zwischen den Werten geschrieben werden ",":ios.sdputc(",") 'Komma schreiben tp++ 0,":":ios.sdputc(fReturn) 'ende der Zeile wird mit Doppelpunkt oder kein weiteres Zeichen markiert ios.sdputc(fLinefeed) quit 143: ' CLOSE fileOpened := false close 144: ' DELETE " Input_String mount if ios.sddel(@f0) errortext close 145: ' REN " "," " Input_String bytemove(@file1, @f0, strsize(@f0)) 'ergebnis vom ersten scanfilename in file1 merken komma 'fehler wenn komma fehlt Input_String mount if ios.sdrename(@file1,@f0) 'rename durchfuehren errortext 'fehler wenn rename erfolglos close 146: ' DIR if is_String Input_String komma a:=expr(1) h_dir(dzeilen,a,@f0) elseifnot spaces h_dir(dzeilen,modus,@ext5) 'directory ohne parameter nur anzeigen else param(1) dzeilen:=prm[0] modus:=prm[1] h_dir(dzeilen,modus,@ext5) 147: ' SAVE or SAVE "" if is_String 'Dateiname? dann normales Speichern Input_String a:=0 if spaces=="," 'speichern ohne zurueckverwandelte token komma a:=expr(1) d:=ifexist(@f0) if d==1 'datei speichern binsave close 148: ' LOAD or LOAD "" mount if is_String Input_String a:=0 if spaces=="," 'Autostartfunktion ? (Load"name.ext",1) komma a:=expr(1) if ios.sdopen("R",@f0) 'Open requested file errortext case a 0:newprog binload(0) Prg_End_Pos 1:newprog 'BIN Datei mit Autostart binload(0) clearvars 2: 'Append-Funktion binload(speicherende-2) 3: c:=nextlineloc 'Replace-Funktion Prg_End_Pos b:=klammer 'Zeilen an Zeilenposition schreiben binload(findline(b)) nextlineloc := c 'Programmadresse zurückschreiben restart:=1 'Programm fortsetzen close 152:'Gfile mit Parameter a:=expr(1) getfilename(a) 153:'MAP Map d=Map anzeigen, MAP w=Map in eram schreiben, Map s=Map auf sd-card schreiben, Map l=Map von sd-laden Map_function 154: ' FOR = TO {STEP } For-Next Schleifen funktionieren nicht mit arrays als Operanden ht := spaces skipspaces nt := spaces a := fixvar(ht) skipspaces varis(a,expr(0),1,0,0,0) skipspaces forLimit[a] := expr(0) if spaces == 156 ' STEP 'Save step size skipspaces forStep[a] := expr(0) else forStep[a] := fl.ffloat(1) 'Default step is 1 forLoop[a] := nextlineloc 'Save address of line c:=varis(a,0,0,0,0,0) if forStep[a] < 0 'following the FOR b := c=>forLimit[a] else 'Initially past the limit? b := c=< forLimit[a] if not b 'Search for matching NEXT repeat while nextlineloc < speicherende-2 tp := nextlineloc + 2 nextlineloc := tp + strsize(tp) + 1 if spaces == 157 'NEXT nt := skipspaces 'Variable has to agree if fixvar(nt) == a 'If match, continue after quit 'the matching NEXT 157: ' NEXT nt := spaces a := fixvar(nt) tp++ c:=varis(a,0,0,0,0,0) h:=fl.fadd(c,forStep[a]) 'Increment or decrement the varis(a,h,1,0,0,0) 'neuen wert fuer vars[a] if forStep[a] < 0 'FOR variable and check for b := h=> forLimit[a] else 'the limit value b := h=< forLimit[a] if b 'If continuing loop, go to nextlineloc := forLoop[a] 'statement after FOR tp++ 158:'SID SID_SOUND 159:'PLAY if is_string input_string mount if ios.sdopen("R",@f0) errortext play:=1 ios.sid_sdmpplay(@f0) 'in stereo elseif spaces == "0" ios.sid_dmpstop play:=0 close elseif spaces == "1" ios. sid_dmppause 161:'PUT param(2) ios.put(prm[0],prm[1],prm[2]) 162:'tload a:=expr(1) a&=15 komma if is_string 'test auf String Input_String komma param(1) b:=prm[0] c:=prm[1] if a==15 LoadTiletoRam(16,@f0,1,1) 'Mauszeigerdatei else LoadTiletoRam(a,@f0,b,c) 'Tile-Datei in den Ram schreiben 166:'READ (DATA) if restorepointer DATA_READ 167:'Window Window_Function 175:'RESTORE (DATA) ifnot spaces DATA_POKE(1,0) 'erste Data-Zeile suchen, falls vorhanden if restorepointer 'DATA-Zeilen vorhanden DATA_POKE(0,restorepointer) 'Datazeilen in den E-Ram schreiben datapointer:=0 else SET_RESTORE(expr(1)) 178:'STILE a:=expr(1) if a and a<16 loadtile(a) 'tileset aus eram in bella laden 179:'Tile param(5) 'nr,farbe1,farbe2,farbe3,x,y 'tileblock-nr aus aktuellem tileset anzeigen ios.displayTile(prm[0],prm[1],prm[2],prm[3],prm[5],prm[4]) if mapram==1 tilecounter++ ios.ram_wrword(tilecounter,MAP_RAM) 'tilecounter in ram schreiben a:=MAP_RAM+8+((prm[4]*6)+(prm[5]*40*6)) 'berechnung der speicheradresse repeat b from 0 to 5 write_ram(prm[b],a++) 180: ' END Prg_End_Pos return 181: ' PAUSE {,} pauseTime := expr(1) waitcnt((clkfreq /1000*pausetime) +cnt) 182: ' FILE = skipspaces if ios.sdputc(expr(1)) errortext 'Dateifehler 185:'MKFILE Datei erzeugen Input_String mount if ios.sdnewfile(@f0) Errortext '@syn close 186: ' DUMP , ,ram-typ param(2) ios.dump(prm[0],prm[1],prm[2]) '******************************** neue Befehle **************************** 190:'pos , cursor an position x,y a:=expr(1) komma b:=expr(1) ios.setpos(b,a) 193:'TIME a:=expr(1) 'x komma b:=expr(1) 'y ios.time(a,b) 187:'Col ,, param(2) prm[0]&=255 prm[1]&=255 prm[2]&=255 farbe:=prm[0] hintergr:=prm[1] cursorcolor:=prm[2] ios.printboxcolor(win,prm[0],prm[1],prm[2]) 188: 'CLS ios.printchar(12) 189: 191:'Mouse param(1) prm[0]&=1 prm[1]&=255 ios.displaymouse(prm[0],prm[1]) 192:'Plot param(2) 'farbe,x,y ios.PlotPixel(prm[0],prm[1],prm[2]) 194:'scrdn param(6) ios.scrolldown(prm[0],prm[1],prm[3],prm[2],prm[5],prm[4],prm[6]) 195:'scrup scrollUp(lines, color, startRow, startColumn, endRow, endColumn,rate) param(6) 'farbe,x,y,xx,yy ios.scrollup(prm[0],prm[1],prm[3],prm[2],prm[5],prm[4],prm[6]) 196:'croff cursor:=0 ios.printCursorRate(0) 197:'cron cursor:=1 ios.printCursorRate(3) 198:'stime a:=expr(1) skipspaces'is_spaces(":",1) b:=expr(1) skipspaces'is_spaces(":",1) c:=expr(1) ios.setHours(a) ios.setMinutes(b) ios.setSeconds(c) 199:'sdate param(3) ios.setDate(prm[0]) ios.setMonth(prm[1]) ios.setYear(prm[2]) ios.setDay(prm[3]) 202:'Button Buttons 206:'MKDIR input_string mount if ios.sdnewdir(@f0) errortext close 207:'PORT Port_Funktionen 208:'POKE Poke(adresse, wert, byte;word;long) param(2) if prm[2]==1 write_ram(prm[1],prm[0]) elseif prm[2]==2 ios.ram_wrword(prm[1],prm[0]) else ios.ram_wrlong(prm[1],prm[0]) 209:'Circle a:=expr(1) 'farbe komma b:=expr(0) 'x komma c:=expr(0) 'y komma d:=expr(0) 'radius circle(b,c,d,a) 'x,y,r,farbe 210:'Line param(4) 'farbe,x,y,xx,yy ios.Plot_Line(prm[1],prm[2],prm[3],prm[4],prm[0]) 'x,y,xx,yy,farbe 211:'FUNC nt:=spaces f:=0 e:=0 if isvar(nt) a:=fixvar(nt) 'Funktionsvariablen-name (a..z) skipspaces klammerauf f:=get_input_read(4) 'max.4 Variablen klammerzu is_spaces(61,25) '= is_spaces(91,25) '[ scanfilename(@f0,0,93) 'Formelstring extrahieren d:=FUNC_RAM+(a*56) 'Adresse der Function im Ram ios.ram_wrlong(prm[0],d) 'Variablenadresse in Funktionsram schreiben h:=1 e:=d repeat 3 e+=4 if f>1 ios.ram_wrlong(prm[h++],e) 'Operandenadressen in den Funktionsram schreiben, wenn vorhanden f-- else ios.ram_wrlong(0,e) 'nicht benutzte Operanden mit 0 beschreiben stringschreiben(d+16,0,@f0,1,0) 'Formel in den Funktionsram schreiben 213:'clear clearing 214:'bye ende 'T-Basic beenden 217:'BEEP ifnot spaces 'keine parameter ios.sid_beep(0) else a:=expr(1) 'Tonhoehe ios.sid_beep(a) 218:'BLOAD Input_String mount if ios.sdopen("R",@f0) errortext ios.ldbin(@f0) 219: 'PLAYER Playersettings 220: ' 222:'LAN ' Lan_Function 224:'MBound param(3) ios.mousebound(prm[0],prm[1],prm[2],prm[3]) 226:'frame param(6) ios.display3DFrame(prm[0], prm[1], prm[2], prm[4], prm[3], prm[6], prm[5]) 227:'WSET a:=expr(1) a&=7 ios.printwindow(a) win:=a 228:'TPIC 'komplettes Tileset anzeigen param(4) 'farbe1,farbe2,farbe3,x,y ios.displaypic(prm[0],prm[1],prm[2],prm[4],prm[3],ytiles[aktuellestileset],xtiles[aktuellestileset]) 229:'SCROLL Input_String komma param(5) 'scrollrate,textfarbe,hintergrundfarbe,x,y,xx ios.scrollString(@f0,prm[0], prm[1], prm[2], prm[4], prm[3], prm[5]) 230:'CHDIR Input_String bytefill(@workdir,0,12) bytemove(@workdir,@f0,strsize(@f0)) mount close 231:'box param(5) 'farbe,x,y,xx,yy,Schatten ja/nein ios.display2dbox(prm[0],prm[2],prm[1],prm[4],prm[3],prm[5]) 'farbe,y,x,yy,xx 232:'Font Input_String komma param(4) '1.farbe,2.farbe,3.farbe,x,y printfont(@f0,prm[0],prm[1],prm[2],prm[3],prm[4]) 'Text mit aktuellen Font darstellen 234:'FN um ein Setzen der Präzision ohne Werterückgabe zu ermöglichen mathfunction 239:'timer timerfunction 237:'Dim repeat b:=0 if raute 'String-Felddimensionierung b:=2 elseif isvar(spaces) 'Zahlen-Felddimensionierung b:=1 a:=fixvar(spaces) skipspaces klammers 'Klammerwerte lesen Felddimensionierung(a,b,var_arr[0],var_arr[1],var_arr[2]) 'a-x b-y c-z d-variable e-String oder Zahl} if spaces=="," skipspaces else quit 242:'PLAYXY Spielerfigur bewegen a:=expr(1) playerposition(a) 243:'COM Comfunktionen 245:'XBUS-Funktionen BUS_Funktionen 249:'Sprite-Settings spritesettings 251:'Backup Bildschirmbereich sichern param(4) ios.Backup_Area(prm[0],prm[1],prm[2],prm[3],prm[4]) 'Backup_Area(x,y,xx,yy,adr) 252:'Recover Bildschirmbereich zurückschreiben param(4) ios.Restore_Area(prm[0],prm[1],prm[2],prm[3],prm[4]) 'Restore_Area(x,y,xx,yy,adr) '****************************ende neue befehle******************************** if spaces == ":" 'existiert in der selben zeile noch ein befehl, dann von vorn restart := 1 tp++ con'******************************************* DATA-Funktion ******************************************************************************************************************** PRI DATA_READ|anz 'READ-Anweisungen interpretieren, Data-Werte lesen und an die angegebenen Variablen verteilen anz:=0 anz:=Get_input_read(9) 'Array Adressen berechnen FILL_ARRAY(anz,1) 'Arrays mit Daten füllen pri data_write(adr,art)|adresse,a,c,i,f 'schreibt die Data-Anweisungen in die entsprechenden Variablen adresse:=DATA_RAM+datapointer a:=DATA_LESEN(adresse) datapointer:=a-DATA_RAM i:=0 f:=strsize(@font) if art==0 repeat f 'String aus Data-Puffer lesen c:=byte[@font][i++] write_ram(c,adr++) 'und nach String-Array schreiben write_ram(0,adr++) 'Null-string-Abschluss else c:=fs.StringToFloat(@font) 'String-Zahl in Float-Zahl umwandeln und im Array speichern ios.ram_wrlong(c,adr) PRI DATA_LESEN(num) | p,i 'Data-Wert im Eram lesen i:=0 repeat p:=read_ram(num++) 'string aus eram lesen und in @font schreiben egal, ob Zahl oder Zeichenkette if p==44 or p==0 'komma oder null quit 'dann raus byte[@font][i++]:=p byte[@font][i]:=0 'String mit Nullbyte abschliessen return num 'Endadresse zurückgeben PRI SET_RESTORE(lnr)|a 'DATA-Zeiger setzen a:=findline(lnr) if read_ram(a+2)==168 'erste Data-Anweisung gefunden? restorepointer:=a 'Restorepointer setzen data_poke(0,restorepointer) 'Data-Zeilen in den Data-Speicher schreiben datapointer:=0 'Data-Pointer zurücksetzen PRI DATA_POKE(mode,pointer)|a,adr,b,c,d,merker 'DATA-Zeilen in den Ram schreiben a := pointer 'entweder 0 oder Restore-Zeiger adr:=DATA_RAM repeat while a < speicherende-2 d := ios.ram_rdword(a) 'zeilennummer aus eram holen a+=2 'nach der Zeilennummer kommt der Befehl c:= read_ram(a) '1.Befehl in der Zeile muss DATA heissen if c==168 'Befehl heisst DATA if merker==1 write_ram(44,b-1) 'komma setzen nach für nächste Data-Anweisung if mode==1 'Adresse der ersten Data-Zeile restorepointer:=a-2 quit merker:=1 'erste DATA-Anweisung schreiben, ab jetzt wird nach jeder weiteren Anweisung ein Komma gesetzt a+=1 a:=stringlesen(a) 'DATA-Zeile Lesen b:=stringschreiben(adr,0,@font,1,1) 'DATA-Zeile in den RAM schreiben adr:=b else a:=ios.ram_keep(a)'+1 'zur nächsten zeile springen ios.ram_wrlong(0,adr) 'abschließende nullen für Ende Databereich Pri FILL_ARRAY(b,mode)|a,f repeat a from 1 to b 'Arraywerte schreiben if prm[a-1]>$6AFFF and prm[a-1]<$7FFFF 'Adresse im Array-Bereich?, dann Zahlenvariable if mode data_write(prm[a-1],1) else f:=getanynumber ios.ram_wrlong(f,prm[a-1]) 'zahl im Array speichern elseif prm[a-1]>$7FFFF 'String if mode data_write(prm[a-1],0) else scanFilename(@f0,0,44) 'Zeilen-Teil bis Komma abtrennen stringschreiben(prm[a-1],0,@f0,1,0) 'String im Stringarray speichern if a0 DisplayMap 'Map anzeigen return "w","W": mapram:=1 'schreibmarker fuer ram jeder Tilebefehl wird jetzt zusaetzlich in den Ram geschrieben tilecounter:=0 write_ram(farbe,MAP_RAM+2) 'Header mit farbwerten fuellen write_ram(hintergr,MAP_RAM+3) write_ram(cursorcolor,MAP_RAM+4) write_ram(0,MAP_RAM+5) write_ram(0,MAP_RAM+6) write_ram(0,MAP_RAM+7) 'Rest des Headers mit nullen fuellen "l","L": 'map von sd-card in eram laden skipspaces Input_String Lmap(@f0) "s","S": 'map aus eram auf sd-card speichern skipspaces Input_String Smap(@f0) "c","C": 'Map-Ram_Shadow-BS-Speicher löschen ios.ram_fill(MAP_RAM,$1C27,0) con'***************************************************** XBUS-Funktionen ******************************************************************************************************* PRI BUS_Funktionen |pr,a,b,c,h,r,str,s pr:=0 'pr gibt zurück, ob es sich beim Rückgabewert um einen String oder eine Variable handelt, für die Printausgabe klammerauf a:=expr(1) 'Chipnummer (1-Administra,2-Bella,3-Venatrix) komma r:=expr(1) 'wird ein Rückgabewert erwartet? 0=nein 1=char 4=long 3=string s:=0 repeat komma if is_string Input_String s:=1 else b:=expr(1) 'Kommando bzw Wert if b>255 case a 1:ios.bus_putlong1(b) 2:ios.bus_putlong2(b) 3:ios.bus_putlong3(b) else case a 1:ios.bus_putchar1(b) 2:ios.bus_putchar2(b) 3:ios.bus_putchar3(b) if s==1 lookup(a:ios.bus_putstr1(@f0),ios.bus_putstr2(@f0),ios.bus_putstr3(@f0)) s:=0 if spaces==")" quit skipspaces case r 0:pr:=0 return 1:c:=lookup(a:ios.bus_getchar1,ios.bus_getchar2,ios.bus_getchar3) 4:c:=lookup(a:ios.bus_getlong1,ios.bus_getlong2,ios.bus_getlong3) 3:if a==1 str:=ios.bus_getstr1 if a==3 str:=ios.bus_getstr3 bytemove(@font,str,strsize(str)) pr:=1 if r==1 or r==4 h:=fl.ffloat(c) str:=fs.floattostring(h) 'Stringumwandlung für die Printausgabe bytemove(@font,str,strsize(str)) return h con'******************************************** Port-Funktionen der Sepia-Karte ************************************************************************************************* PRI PORT_Funktionen|function,a,b,c function:=spaces skipspaces klammerauf a:=expr(1) 'Adresse bzw.ADDA Adresse case function "O","o":komma b:=expr(1) 'Byte-Wert, der gesetzt werden soll klammerzu c:=a-4 'Portadresse generieren a:=c+PORT 'Port 4=Adresse+0 Port5=Adresse+1 usw. da nur Register 4-6 Ausgaberegister sind ios.plxOut(a,b) 'wenn a=4 dann 28+4=32 entspricht Adresse$20 von Digital-Port1 "I","i":'Port I 'Byte von Port a lesen klammerzu return ios.getreg(a) 'Registerwert auslesen 0-6 "S","s":'Port Set '*Adressen zuweisen komma b:=expr(1) '*Port-Adresse zuweisen ADDA:=a PORT:=b klammerzu ios.set_plxAdr(ADDA,PORT) "P","p":'Port-Ping 'Port-Adresse anpingen klammerzu ios.plxHalt b:=ios.plxping(a) ios.plxrun return b con'********************************************* serielle Schnittstellen-Funktionen ********************************************************************************************* PRI Comfunktionen|function,a,b function:=spaces skipspaces case function "S","s":klammerauf a:=expr(1) 'serielle Schnittstelle öffnen/schliessen if a==1 komma 'wenn öffnen, dann Baudrate angeben b:=expr(1) ios.seropen(b) serial:=1 elseif a==0 'Schnittstelle schliessen ios.serclose serial:=0 klammerzu "G","g":'COM G 'Byte von ser.Schnittstelle lesen ohne warten return fl.ffloat(ios.serread) "R","r":'COM R 'Byte von ser.Schnittstelle lesen mit warten return fl.ffloat(ios.serget) con '******************************************* Parameter des Player's und der Sprites ******************************************************************************************* PRI playersettings|f,i,e f:=spaces skipspaces klammerauf case f "P","p":param(5) 'Spielerparameter ios.Actorset(prm[0],prm[1],prm[2],prm[3],prm[4],prm[5]) 'Actorset(tnr1,col1,col2,col3,x,y) "K","k":param(4) 'Spielertasten belegen ios.setactionkey(prm[0],prm[1],prm[2],prm[3],prm[4]) 'links,rechts,hoch,runter,feuer repeat i from 0 to 4 actionkey[i]:=prm[i] 'links "B","b":param(9) 'Blockadetiles einlesen (tnr1,....tnr10) repeat i from 0 to 9 block[i]:=prm[i] ios.send_block(i,prm[i]) "I","i":param(5) 'Item-Tiles einlesen (tnr1,...tnr6) repeat i from 0 to 5 item[i]:=prm[i] "C","c":param(5) 'Kollisions-Tiles (tnr1,...tnr6) repeat i from 0 to 5 collision[i]:=prm[i] "E","e":param(4) 'Ersatz-Item-Tiles (nr1-6,tnr,f1,f2,f3) e:=(prm[0]-1)*5 f:=0 repeat i from e to e+4 itemersatz[i]:=prm[f++] klammerzu PRI playerposition(a)|b,c,d,i,bl 'Hier wird die Playerbewegung auf Blockadetiles überprüft bl:=0 get_position b:=actorpos[0] c:=actorpos[1] if a==actionkey[0] d:=read_ram(MAP_RAM+8+((b-1)*6)+(c*40*6)) elseif a==actionkey[1] d:=read_ram(MAP_RAM+8+((b+1)*6)+(c*40*6)) elseif a==actionkey[2] d:=read_ram(MAP_RAM+8+((b*6)+((c-1)*40*6))) elseif a==actionkey[3] d:=read_ram(MAP_RAM+8+((b*6)+((c+1)*40*6))) elseif a==actionkey[4] 'Unterroutine Feuertaste, noch nicht vorhanden repeat i from 0 to 9 if block[i]==d bl:=1 if bl==0 ios.setactor_xy(a) PRI Kollisionserkennung:a|d,i a:=0 d:=get_position repeat i from 0 to 5 if collision[i]==d a:=2 'Kollision des Spielers mit Kollisionstiles quit PRI get_position:d actorpos[0]:=ios.get_actor_pos(1) 'x-pos actorpos[1]:=ios.get_actor_pos(2) 'y-pos d:=read_ram(MAP_RAM+8+((actorpos[0]*6)+(actorpos[1]*40*6))) 'Tile an aktueller Position im Map-Speicher lesen PRI Item_sammeln:a|d,i,e,f a:=0 d:=get_position 'item auf dem der Player gerade steht repeat i from 0 to 5 if item[i]==d a:=1+i 'Item-Nr zurückgeben e:=MAP_RAM+8+((actorpos[0]*6)+(actorpos[1]*40*6)) f:=i*5 write_ram(itemersatz[f+1],e)'gesammeltes Item wird durch Ersatzitem im ERam ersetzt (um Doppeleinsammlung zu verhindern) ios.Change_Backuptile(itemersatz[f+1],itemersatz[f+2],itemersatz[f+3],itemersatz[f+4]) 'ersatzitem wird in Backuppuffer des Players geschrieben (ersetzt) 'damit stimmt jetzt auch die Farbe des Ersatzitems quit PRI spritesettings|f f:=spaces skipspaces klammerauf case f "S","s":ios.set_sprite_speed(expr(1)) 'Speed "M","m":ios.Sprite_Move(expr(1)) 'move an aus reset "P","p":param(10) 'Spriteparameter ios.set_sprite(prm[0],prm[1],prm[2],prm[3],prm[4],prm[5],prm[6],prm[7],prm[8],prm[9],prm[10]) 'Nr,Tnr,Tnr2,f1,f2,f3,dir,strt,end,x,y) klammerzu con'*************************************************************** Array-Dimensionierung **************************************************************************************** PRI Felddimensionierung(variabl,var_str,x_koord,y_koord,z_koord)|ort if var_str==1 'Zahlenfelddimensionen speichern ort:=DIM_VAR+(2*variabl*3) else 'String-Felddimensionen speichern ort:=DIM_STR+(2*variabl*3) ios.ram_wrword(x_koord+1,ort) ios.ram_wrword(y_koord+1,ort+2) ios.ram_wrword(z_koord+1,ort+4) PRI spaces | c 'einzelnes zeichen lesen repeat c := byte[tp] if c==21 or c==17 'Wurzelzeichen und Pi-Zeichen return c if c == 0 or c > " " return c tp++ PRI skipspaces if byte[tp] tp++ return spaces PRI parseliteral | r, c 'extrahiere Zahlen aus der Basiczeile r := 0 repeat c := byte[tp] if c < "0" or c > "9" return r r := r * 10 + c - "0" tp++ PRI fixvar(c) 'wandelt variablennamen in Zahl um (z.Bsp. a -> 0) if c => "a" c -= 32 return c - "A" PRI isvar(c) 'Ueberpruefung ob Variable im gueltigen Bereich c := fixvar(c) return c => 0 and c < 26 PRI circle(x,y,r,frbe)|i,xp,yp,a,b,c,d d:=630 '(2*pi*100) repeat i from 0 to d step 3 c:=fl.fdiv(fl.ffloat(i),fl.ffloat(100)) a:=fl.fadd(x,fl.fmul(fl.cos(c),r)) b:=fl.fadd(y,fl.fmul(fl.sin(c),r)) xp:=fl.FRound(a) yp:=fl.FRound(b) ios.PlotPixel(frbe,xp,yp) PRI playerstatus ios.sid_dmpstop play:=0 close PRI param(anzahl)|i i:=0 repeat anzahl prm[i++]:=expr(1) 'parameter mit kommatrennung komma prm[i++]:=expr(1) 'letzter Parameter ohne skipspaces pri is_string 'auf String überprüfen result:=0 if spaces==quote or spaces=="#" or spaces==176 or spaces==236 or spaces==163 result:=1 PRI komma is_spaces(",",1) PRI is_spaces(zeichen,t) skipspaces PRI raute skipspaces return 1 PRI klammer:b skipspaces b:=expr(1) skipspaces PRI klammerauf 'is_spaces(40,1) skipspaces PRI klammerzu 'is_spaces(41,1) skipspaces PRI getAnyNumber | c, t,i,punktmerker,d,zahl[STR_MAX] case c := byte[tp] quote: if result := byte[++tp] if byte[++tp] == quote tp++ "$": c := byte[++tp] t := hexDigit(c)' < 0 result := t c := byte[++tp] repeat until (t := hexDigit(c)) < 0 result := result << 4 | t c := byte[++tp] result:=fl.FFLOAT(result) "%": c := byte[++tp] result := c - "0" c := byte[++tp] repeat while c == "0" or c == "1" result := result << 1 | (c - "0") c := byte[++tp] result:=fl.FFLOAT(result) "0".."9": i:=0 punktmerker:=0 c:=byte[tp++] repeat while c=="." or c=="e" or c=="E" or (c => "0" and c =< "9") 'Zahlen mit oder ohne punkt und Exponent if c==point punktmerker++ if punktmerker>1 'mehr als ein punkt errortext 'Syntaxfehler ausgeben if c=="e" or c=="E" d:=byte[tp++] if d=="+" or d=="-" byte[@zahl][i++]:=c byte[@zahl][i++]:=d c:=byte[tp++] next byte[@zahl][i++]:=c c:=byte[tp++] byte[@zahl][i]:=0 result:=fs.StringToFloat(@zahl) --tp PRI hexDigit(c) '' Convert hexadecimal character to the corresponding value or -1 if invalid. if c => "0" and c =< "9" return c - "0" if c => "A" and c =< "F" return c - "A" + 10 if c => "a" and c =< "f" return c - "a" + 10 return -1 pri zahlenformat(h)|j j:=fl.ftrunc(h) if (j>MAX_EXP) or (j999999 oder <-999999 werden in Exponenschreibweise dargestellt return FS.FloatToScientific(h) 'Zahlenwerte mit Exponent else return FS.FloatToString(h) 'Zahlenwerte ohne Exponent con '****************************************** Directory-Anzeige-Funktion ******************************************************************************************************* PRI h_dir(z,modes,str) | stradr,n,i,dlen,dd,mm,jj,xstart 'hive: verzeichnis anzeigen {{h_dir - anzeige verzeichnis}} 'mode 0=keine Anzeige,mode 1=einfache Anzeige, mode 2=erweiterte Anzeige ios.printcursorrate(0) 'cursor ausschalten mount xstart:=ios.getx 'Initial-X-Wert if strsize(str)<3 str:=@ext5 'wenn kein string uebergeben wird, alle Dateien anzeigen else repeat 3 'alle Zeichen von STR in Großbuchstaben umwandeln if byte[str][i]>96 byte[str][i]^=32 i++ ios.sddir 'kommando: verzeichnis öffnen n := 0 'dateizaehler i := 0 'zeilenzaehler repeat while (stradr:=ios.sdnext)<>0 'wiederholen solange stradr <> 0 dlen:=ios.sdfattrib(0) 'dateigroesse dd:=ios.sdfattrib(10) 'Aenderungsdatum tag mm:=ios.sdfattrib(11) 'Aenderungsdatum monat jj:=ios.sdfattrib(12) 'Aenderungsdatum Jahr scanstr(stradr,1) 'dateierweiterung extrahieren ifnot ios.sdfattrib(17) 'unsichtbare Dateien ausblenden if strcomp(@buff,str) or strcomp(str,@ext5) 'Filter anwenden n++ '################## Bildschrirmausgabe ################################## if modes>0 ios.print(stradr) if modes==2 erweitert(xstart,dlen,dd,mm,jj) ios.printnl ios.setx(xstart) i++ if i==z '********************************** if ios.keywait == ios#CHAR_ESC 'auf Taste warten, wenn ESC dann Ausstieg if cursor==1 '********************************** ios.printCursorRate(3) '********************************** ios.printnl '********************************** close '********************************** filenumber:=n 'Anzal der Dateien merken abort '********************************** i := 0 '********************************** ios.printnl ios.setx(xstart) if modes==0 if nBUTTON_CNT or bnr<1 errortext adr:=BUTT_RAM+((bnr-1)*40) case a ' 0 1 2 3 "t","T":komma param(3) 'vordergr,hintergr,x-pos,y-pos,Buttontext komma Input_String prm[4]:=prm[2]+strsize(@f0)+1 ios.Plot_Line(prm[2], prm[3],prm[4],prm[3],prm[1]) 'Button darstellen ios.printfont(0,@f0,prm[1],prm[0],0,prm[3],prm[2]+1,0) 'Text mit aktuellen Font darstellen c:=Buttonparameter(5,adr) 'Button-Parameter in den Ram schreiben stringschreiben(c++,0,@f0,1,0) 'Button-Text in den Ram schreiben button_art[bnr-1]:=1 'Art des Buttons 1=Text 2=Icon ios.send_button_param(bnr,prm[2],prm[3],prm[4]) 'Button-Koordinaten nach Bella senden zur Maus-Verarbeitung "i","I":'Icon-Button 0 1 2 3 4 5 komma param(5) 'tilenr,vordergr,hintergr,3.Farbe,x pos,y-pos ios.displayTile(prm[0],prm[1],prm[2],prm[3],prm[5],prm[4]) 'einzelnes Tile anzeigen ('displayTile(tnr,pcol,scol,tcol, row, column)) Buttonparameter(6,adr) button_art[bnr-1]:=2 'Art des Buttons 1=Text 2=Icon ios.send_button_param(bnr,prm[4],prm[5],prm[4]) 'Button-Koordinaten nach Bella senden zur Maus-Verarbeitung "r","R":'Reset ios.destroy3dbutton(bnr) 'button löschen button_art[bnr-1]:=0 'Button-Art löschen 'other: ' errortext klammerzu pri Buttonpress_on(h)|adr,a,b,c,d,e,f',g,tnr adr:=BUTT_RAM+((h-1)*40) 'Textbutton - Icon a:= read_ram(adr++) 'vordergr - tnr b:= read_ram(adr++) 'hintergrund - f1 c:= read_ram(adr++) 'tx - f2 d:= read_ram(adr++) 'ty - f3 e:= read_ram(adr++) 'txx - x if button_art[h-1]==1 'Textbutton stringlesen(adr++) 'Button-String holen ios.Plot_Line(c,d,e,d,a) 'Button revers zeichnen printfont(@font,a,b,0,c+1,d) 'Text mit aktuellen revers Font darstellen repeat while ios.mouse_button(0) ios.Plot_Line(c,d,e,d,b) 'Button normal zeichnen printfont(@font,b,a,0,c+1,d) 'Text mit aktuellen Font darstellen if button_art[h-1]==2 'Icon-Button f:=read_ram(adr++) 'y-Position des Icon ios.displayTile(a,c,b,d,f,e) 'einzelnes Tile revers anzeigen ('displayTile(tnr,pcol,scol,tcol, row, column)) repeat while ios.mouse_button(0) ios.displayTile(a,b,c,d,f,e) 'einzelnes Tile anzeigen ('displayTile(tnr,pcol,scol,tcol, row, column)) pri buttonparameter(sl,adr):c|i 'Buttonparameter in den Ram schreiben i:=0 repeat sl write_ram(prm[i++],adr++) c:=adr pri read_ram(adr) result:=ios.ram_rdbyte(adr) pri write_ram(wert,adr) ios.ram_wrbyte(wert,adr) pri read_filename|a,i a:=ios#PARAM i:=0 repeat while f0[i++]:=ios.ram_rdbyte(a++) 'Parametertext einlesen f0[i]:=0 if i>0 mount ios.sdopen("R",@f0) newprog binload(0) DAT {{ TERMS OF USE: MIT License Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, exprESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. }}