Basic/source/Basic-Runtime.spin

2758 lines
128 KiB
Plaintext
Raw Normal View History

2014-06-14 15:03:48 +02:00
{{ ---------------------------------------------------------------------------------------------------------
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 i<laenge 'Cursor hoch-Taste ans ende der Basiczeile springen
ios.printright
i++
005:repeat i 'Cursor runter-Taste an den Anfang der Basic-Zeile springen
ios.printleft
i:=0
'******************* Funktionstasten abfragen *************************
219:ende 'taste F12 basic beenden
'**********************************************************************
fReturn:Returnmarker:=1 'wenn return gedrueckt
ios.printnl
tline[i] := 0
tp := @tline 'tp bzw tline ist die gerade eingegebene zeile
return
other:
if i < linelen-1
ios.printchar(c)
tline[i++] :=c
if i>laenge
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=<laenge-1
write_ram(c9,adre++)
else
quit
else
write_ram(chr,adre++) 'chr-Funktion
write_ram(0,adre++) 'null schreiben fuer ende string
2:ios.sdputstr(strkette) 'auf SD-Card schreiben
clearstr 'stringpuffer löschen
return adre
PUB strpos (searchAddr,strAddr,offset)| searchsize 'durchsucht strAddr nach auftreten von searchAddr und gibt die Position zurück
searchsize := strsize(searchAddr)
repeat until offset > 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<BUTTON_CNT and a==0
Buttonpress_on(b) 'Buttonpress-Effekt
return fl.ffloat(b)
233:'asc
klammerauf
if raute
a:=getarray
return fl.ffloat(read_ram(a))
elseif spaces==quote
return skipspaces
klammerzu
234:'FN
return mathfunction
239:'timer
return fl.ffloat(timerfunction)
240:'GATTR
a:=klammer
return fl.ffloat(ios.sdfattrib(a))
241:'VAL
klammerauf
Input_String
fnum:=fs.StringToFloat(@f0)
klammerzu
return fnum
243:'COM
return Comfunktionen
244:'INSTR
klammerauf
Input_String
bytefill(@str0,0,STR_MAX)
bytemove(@str0,@f0,strsize(@f0)) 'in 2.Puffer merken
komma
Input_String
c:=strpos(@str0,@f0,0) 'beide vergleichen -1=gleich 0=ungleich
klammerzu
return fl.ffloat(c)
245:'Bus-Funktionen
return Bus_Funktionen
246:'GETX 'Cursorposition x lesen
a:=klammer
if a==1
return fl.ffloat(ios.getx)
elseif a==2
return fl.ffloat(ios.get_actor_pos(1)) 'Playerposition
247:'GEXTY 'Cursorposition y lesen
a:=klammer
if a==1
return fl.ffloat(ios.gety)
elseif a==2
return fl.ffloat(ios.get_actor_pos(2)) 'Playerposition
253:'Ver
return version
'****************************ende neue befehle********************************
139: ' RND <factor>
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
2: 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<<b'lookup(b:sid_triangle,sid_saw,sid_square,sid_noise)
ios.sid1_setWaveform(a,b)
5:'FILTER
param(2)
ios.sid1_setFilterType(prm[0],prm[1],prm[2])
6:'FMASK
param(2)
ios.sid1_setFilterMask(prm[0],prm[1],prm[2])
7:'RGMOD
param(2)
ios.sid1_enableRingmod(prm[0],prm[1],prm[2])
8:'CUT
a:=expr(1)
komma
b:=expr(1)
ios.sid1_setCutoff(a)
ios.sid1_setResonance(a)
9:'PWM
param(1)
ios.sid1_setPWM(prm[0],prm[1])
10:'SYNC
param(2)
ios.sid1_enableSynchronization(prm[0],prm[1],prm[2])
klammerzu
PRI mathfunction |i,err 'Liste der verfügbaren mathematischen Funktionen
i:=0
err:=1
scanfilename(@math,1,40)
tp--
klammerauf
repeat 18
if strcomp(@math,@@mtoks[i++])
err:=0
quit
case i
1:result := fl.sin(expr(0)) 'Sinus +
2:result := fl.cos(expr(0)) 'Cosinus +
3:result := fl.tan(expr(0)) 'Tangens +
4:result := fl.log(expr(0)) 'natürlicher Logarithmus +
5:result := fl.exp(expr(0)) 'e-funktion e(1)=2.718281 +
6:result := fl.ffloat(fl.FTRUNC(expr(0))) 'nächst kleinerer Integerwert von X +
7:result := fl.Log10(expr(0)) 'Logarithmus zur Basis 10 +
8:result := fl.ATan(expr(0)) 'Arc Tangens +
9:num1:=expr(1) 'Genauigkeit setzen +
ifnot num1&7' num1<1 or num1>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)
12:Get_term(1) 'shift right +
result:=fl.ffloat(num1>>num2)
13:Get_Term(1) 'reverse
result:=fl.ffloat(num1><num2)
14:Get_Term(1) 'bitwise or
result:=fl.ffloat(num1|num2)
15:Get_Term(1) 'bitwise xor
result:=fl.ffloat(num1^num2)
16:Get_Term(1) 'bitwise and
result:=fl.ffloat(num1&num2)
17:result:=fl.asin(expr(0)) 'arcus sinus +
18:result:=fl.acos(expr(0)) 'arcus cosinus +
klammerzu
PRI Get_term(wert)
num1:=expr(wert)
komma
num2:=expr(wert)
con '*************************************** Dateinamen extrahieren **************************************************************************************************************
PRI scanFilename(f,mode,kennung) | c, chars
chars := 0
if kennung==quote
tp++ 'überspringe erstes Anführungszeichen
repeat while (c := byte[tp++]) <> 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 {"<prompt>";} <var> {, <var>}
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 e<ongosub
skipspaces
e++
a := expr(1)
ongosub:=0
'*************** diese routine verhindert,das bei gleichen Schleifendurchlaeufen immer der gesammte Speicher nach der Zeilennummer durchsucht werden muss ******
if gototemp<>a '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 {<expr> {,<expr>}} 'List in Runtime nicht erlaubt
'Listout
138: ' RUN
clearvars 'alle variablen loeschen
ios.clearkey 'Tastaturpuffer löschen
140: ' OPEN " <file> ", R/W/A
Input_String
if spaces <> ","
'Errortext '@syn
d:=skipspaces
tp++
mount
if ios.sdopen(d,@f0)
errortext
fileOpened := true
141: 'FREAD <var> {, <var> }
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 " <file>
Input_String
mount
if ios.sddel(@f0)
errortext
close
145: ' REN " <file> "," <file> "
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 "<filename>"
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 "<filename>"
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 <var> = <expr> TO <expr> {STEP <expr>} 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 <var>
nt := skipspaces 'Variable has to agree
if fixvar(nt) == a 'If match, continue after
quit 'the matching NEXT
157: ' NEXT <var>
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 <expr> {,<expr>}
pauseTime := expr(1)
waitcnt((clkfreq /1000*pausetime) +cnt)
182:
' FILE = <expr>
skipspaces
if ios.sdputc(expr(1))
errortext 'Dateifehler
185:'MKFILE Datei erzeugen
Input_String
mount
if ios.sdnewfile(@f0)
Errortext '@syn
close
186: ' DUMP <adr>,<zeilen> ,ram-typ
param(2)
ios.dump(prm[0],prm[1],prm[2])
'******************************** neue Befehle ****************************
190:'pos <expr>,<expr> 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 <vordergr>,<hintergr>,<cursor>
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 a<b and mode==0 'weiter, bis kein Komma mehr da ist, aber nicht bei DATA(da werden die Daten ohne Komma ausgelesen, kann also nicht abgefragt werden)
if spaces==","
skipspaces
else
quit
con'***************************************************** Fensterfunktionen *****************************************************************************************************
PRI Window_Function|w,wnr
w:=spaces
skipspaces
klammerauf
wnr:=expr(1)
case w
"c","C":'Create
komma
param(8) '0-vordergrundfarbe,1-hintergrundfarbe,2-cursorfarbe,3-x,4-y,5-xx,6-yy,7=Art,8=Schatten 0-nein 1-ja
komma
Input_String
prm[8]&=1 'nur 1 und Null gültig
ios.window(wnr,prm[0],prm[1],prm[2],prm[2],prm[2],prm[0],prm[2],prm[0],prm[4], prm[3], prm[6], prm[5],prm[7],prm[8])
ios.Set_Titel_Status(wnr,1,@f0)
win:=wnr 'das aktuelle Fenster
"t","T":'Titel
komma
Input_String
ios.Set_Titel_Status(wnr,1,@f0)
"s","S":'Statustext
komma
Input_String
ios.Set_Titel_Status(wnr,2,@f0)
"r","R":'Reset
ios.windel(wnr)
win:=0
klammerzu
con'***************************************************** LAN-Funktionen *********************************************************************************************************
{PRI LAN_Function|a
a:=spaces
case a
"c","C":'Connect
"l","L":'Listen
"w","W":'Wait
"r","R":'Read
"t","T":'Transmit
"g","G":'is_connect?
"s","S":'eingabe IP-Adresse in der Form xxx.xxx.xxx.xxx:xxxx und Start der Verbindung
other:
errortext(1,1)
}
con'***************************************************** MAP-Funktionen *********************************************************************************************************
PRI Map_Function|a
a:=spaces
case a
"d","D":
mapram:=0 'schreibmarker ausschalten
tilecounter:=ios.ram_rdword(MAP_RAM)
if tilecounter>0
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 (j<MIN_EXP) 'Zahlen >999999 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 n<DIR_ENTRY 'Begrenzung der Einträge auf die mit DIR_ENTRY vereinbarte
WriteNameToRam(stradr,n) 'Dateiname zur spaeteren Verwendung in ERam speichern an adresse n
if modes 'sichtbare Ausgabe
ios.printdec(n) 'Anzahl Dateien
'errortext(43,0)
ios.printnl
if cursor==1
ios.printCursorRate(3)
filenumber:=n 'Anzal der Dateien merken
close 'ins Root Verzeichnis ,SD-Card schliessen und unmounten
abort
PRI WriteNameToRam(str,nummer)|adress,position,c 'Dateiliste in ERam schreiben
position:=(nummer-1)*13
adress:=DIR_RAM+position
repeat strsize(str)
c:=byte[str++]
write_ram(c,adress++)
PRI getfilename(nummer)|adress,position,c,num 'mit GFile ausgewaehlte Datei in Stringvariable Z schreiben
position:=(nummer-1)*13
adress:=DIR_RAM+position 'Adresse Dateiname im eRam
num:= scandimension(STR_ARRAY,STR_LEN,25,0,0,0,0,0,0) 'adresse("#Z")
repeat 12
c:=read_ram(adress++) 'Dateiname aus Dir-Ram lesen
write_ram(c,num++) 'und in Variablenspeicher an adresse Z schreiben
write_ram(0,num++) 'null fuer stringende schreiben
PRI erweitert(startx,laenge,tag,monat,jahr) 'erweiterte Dateianzeige
ios.setx(startx+14)
ios.printdec(laenge)
ios.setx(startx+21)
ios.printdec(tag)
ios.setx(startx+24)
ios.printdec(monat)
ios.setx(startx+27)
ios.printdec(jahr)
PRI scanstr(f,mode) | z ,c 'Dateiendung extrahieren
if mode==1
repeat while strsize(f)
if c:=byte[f++] == point 'bis punkt springen
quit
z:=0
repeat 3 'dateiendung lesen
c:=byte[f++]
buff[z++] := c
buff[z++] := 0
return @buff
PRI activate_dirmarker(mark) 'USER-Marker setzen
ios.sddmput(ios#DM_USER,mark) 'usermarker wieder in administra setzen
ios.sddmact(ios#DM_USER) 'u-marker aktivieren
PRI get_dirmarker:dm 'USER-Marker lesen
ios.sddmset(ios#DM_USER)
dm:=ios.sddmget(ios#DM_USER)
con '********************************* Unterprogramme zur Tile-Verwaltung *********************************************************************************************************
PRI Win_Set_Tiles|i,a 'Tiles, aus denen die Fenster bestehen, in den Ram schreiben
i:=WTILE_RAM
a:=0
repeat 18
write_ram(windowtile[a++],i++) 'Standard-Wintiles in den Ram schreiben
ios.windel(9) 'alle Fensterparameter löschen und Win Tiles senden
PRI LoadTiletoRam(tilenr,datei,xtile,ytile)|adress ,count 'tile:=tilenr,dateiname,xtile-zahl,ytilezahl
xtiles[tilenr]:=xtile 'xtiles fuer tilenr '
ytiles[tilenr]:=ytile 'ytiles fuer tilenr
count:=xtile*ytile*64 'anzahl zu ladender Bytes (16*11*16*4=11264)
if tilenr<16
adress:=TILE_RAM+((tilenr-1)*$2C00) 'naechster Tilebereich immer 2816 longs (11264 Bytes) 14 Tilesets moeglich Tileset15 ist der Systemfont
else
adress:=MOUSE_RAM 'Mouse-Pointer
count:=64
mount
activate_dirmarker(basicmarker) 'ins Basic Stammverzeichnis
ios.sdchdir(@tile) 'ins tile verzeichnis wechseln
if ios.sdopen("R",datei) 'datei öffnen
errortext
return
ios.sdxgetblk(adress,count) 'datei in den Speicher schreiben (der blockbefehl ist viel schneller als der char-Befehl)
close
'####Mouse-Pointer############
if tilenr==16
ios.Mousepointer(MOUSE_RAM) 'neuen Mauszeiger übernehmen
PRI loadtile(tileset)|anzahl,adress 'tileset aus eram in bella laden
if tileset==15 'bei Systemfont, Fenstertiles wieder herstellen
Win_Set_Tiles
adress:=TILE_RAM+((tileset-1)*$2C00) 'naechster Tilebereich immer 2816 longs (11264 Bytes) 14 Tilesets moeglich
anzahl:=ytiles[tileset]*xtiles[tileset]*16 'anzahl tilebloecke
ios.loadtilebuffer(adress,anzahl) 'laden
aktuellestileset:=tileset 'zum aktuellen Tileset machen
PRI printfont(str,a,b,c,d,e)|f,x,adr
ios.printfont(win,str,a,b,c,e,d,0)
if mapram==1
repeat strsize(str)
f:= byte[str++]
x:=d*6
adr:=MAP_RAM+8+(e*40*6)
write_ram(f,adr+x++) 'in Shadow-Bildspeicher schreiben
write_ram(a,adr+x++) 'in Shadow-Bildspeicher schreiben
write_ram(b,adr+x++) 'in Shadow-Bildspeicher schreiben
write_ram(c,adr+x++) 'in Shadow-Bildspeicher schreiben
write_ram(d,adr+x++) 'in Shadow-Bildspeicher schreiben
write_ram(e,adr+x++) 'in Shadow-Bildspeicher schreiben
tilecounter++
d++
ios.ram_wrword(tilecounter,MAP_RAM) 'Tile-Zähler in den Ram schreiben
con '************************************* Unterprogramme zur Map-Daten-Behandlung *****************************************************************************************************
PRI lmap(name)|datadresse,counters 'Map-datei von SD-Card in eram laden
datadresse:=MAP_RAM
mount
activate_dirmarker(basicmarker) 'ins Basic Stammverzeichnis
if ios.sdopen("R",name) 'datei vorhanden?
errortext
return
counters:=DPL_CNT 'anzahl speicherstellen
counters*=6 'mit 6 multiplizieren da jedes Tile 6 parameter hat (nr,3xfarbe und x bzw.y)
counters+=8 'plus header
ios.sdxgetblk(datadresse,counters) 'Map in den Speicher laden
close
tilecounter:=ios.ram_rdword(MAP_RAM) 'tilecounter fuer anzeige setzen
PRI smap(name)|datadresse,a,count 'MAP-Datei auf SD-Card schreiben
a:=ifexist(name)
if a==0 or a==2 'Fehler
return
ios.ram_wrword(tilecounter,MAP_RAM) 'counter schreiben
datadresse:= MAP_RAM
count:=(DPL_CNT*6)+8 'counter mit 6 multiplizieren da jedes Tile 6 parameter hat (nr,farbe1-3,x,y), die ersten 8 stellen sind der Header
ios.sdxputblk(datadresse,count) 'Map auf SD-Card speichern
close
PRI DisplayMap|datadr,tnr,f1,f2,f3,tx,ty,contr 'Map-Datei aus eram lesen und anzeigen
farbe :=read_ram(MAP_RAM+2) 'Bildschirmfarben lesen
hintergr :=read_ram(MAP_RAM+3)
cursorcolor:=read_ram(MAP_RAM+4)
ios.printboxcolor(win,farbe,hintergr,cursorcolor) 'Fenster mit Bildschirmfarben erzeugen
ios.printcls
datadr:=MAP_RAM+8 'Start-Position im ERam
repeat DPL_CNT
tnr:=read_ram(datadr++) 'Tilenr
f1 :=read_ram(datadr++) 'farbe1
f2 :=read_ram(datadr++) 'farbe2
f3 :=read_ram(datadr++) 'farbe3
tx :=read_ram(datadr++) 'x-position
ty :=read_ram(datadr++) 'y-position
if contr:=tnr+f1+f2+f3 'Tile da?
ios.displayTile(tnr,f1,f2,f3,ty,tx) 'einzelnes Tile anzeigen ('displayTile(tnr,pcol,scol,tcol, row, column))
con'****************************************** Button-Routinen *************************************************************************************************************
Pri Buttons|a,c,bnr,adr
a:=spaces
skipspaces
klammerauf
bnr:=expr(1) 'Button-Nr
if bnr>BUTTON_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.
}}