  INFO - FAQ - CC2-Forum - CCPro-Forum |
|
||
|
' =========================================================================== ' Demoprogramm: Spiel "Wörtersuchen" - Die Open-Maxi versteckt Wörter ' In OCBASIC 1.12a_e1 für Open-Maxi von Dietmar Harlos am 19. Januar 2022 ' =========================================================================== ' In diesem Programm wird demonstriert, wie Felder, Puffer und Strings auf ' der Open-Maxi realisiert werden können. ' Die Idee stammt von der Website "http://www.kultmags.com/" aus der ' Computerzeitschrift "Happy Computer 1985-03" ab Seite 104. ' An dieser Stelle möchte ich mich bei Dirk von "das |_ Team" und bei Norbert ' für ihre Unterstützung bedanken. In Memoriam Norbert Klein. ' --- Definitionen ---------------------------------------------------------- INCLUDE "omax.def" 'Definitionen für die Open-Maxi DEFINE string &h2aa 'Buffer an 1. Adresse hinter dem USER-RAM DEFINE feld &h2ca 'Array/Feld/Buffer des Spielfelds DIM bitarray BYTE 'ein Bitarray DIM frei BIT[1] OF bitarray 'ist HIGH, wenn Feld frei DIM debug BIT[2] OF bitarray 'ist HIGH, wenn Debugging aktiv DIM a,b,c,d BYTE 'temporäre Bytevariablen DIM lens BYTE 'Länge des Wortes im Stringbuffer DIM xwo,ywo BYTE 'Zwischenspeicher für Koordinaten des Wortes DIM w,x,y WORD 'temporäre Word-Variablen DIM dx,dy WORD 'Schrittweite beim Verstecken des Wortes DIM xw,yw WORD 'Koordinaten des Wortes beim Verstecken ' --- Hauptprogramm --------------------------------------------------------- PrintSpc=ON 'SPACE vor einem dezimalen PRINT End2Host=ON 'Bei Programmende gleich in den Host-Modus wechseln ' Titel: PRINT "Wortsuchspiel" PRINT "=============" ' Initialisierungen: RANDOMIZE 64 'Zufallsgenerator initialisieren (z.B. RANDOMIZE TIMER) debug=OFF 'ON 'OFF 'Nur Wörter anzeigen ' Das Hauptprogramm: FOR d=0 TO 11 '12 Wörter aus der Tabelle verstecken wortverstecken d NEXT d IF NOT(debug) THEN FOR b=0 TO 19 FOR a=0 TO 31 IF PEEK(feld+b*32+a)=0 THEN c=((RAND SHR 1)+16384)/1261 '0..25 POKE feld+b*32+a,65+c END IF NEXT a NEXT b END IF ? anzeigen ?:?"Programmende." END 'Zurück in den Hostmodus. Neustart mit RETURN-Taste. ' --- Subroutinen und Funktionen -------------------------------------------- ' Das Wort mit der Nummer c mittels Brute Force im Feld placieren PROCEDURE wortverstecken(c) gets(c) REPEAT xw=((RAND SHR 1)+16384)/1024 '0..31 yw=((RAND SHR 1)+16384)/1639 '0..19 xwo=xw : ywo=yw 'Koordinaten zwischenspeichern REPEAT dx=((RAND SHR 1)+16384)/10923 '0..2 dx=dx-1 '-1, 0 oder 1 dy=((RAND SHR 1)+16384)/10923 '0..2 dy=dy-1 '-1, 0 oder 1 UNTIL dx<>0 OR dy<>0 frei=TRUE FOR a=1 TO lens IF feldfrei(xw,yw)=FALSE THEN frei=FALSE END IF ADD xw,dx ADD yw,dy NEXT a UNTIL frei=TRUE xw=xwo : yw=ywo 'und Wort ins Feld einfügen FOR a=0 TO lens-1 POKE feld+yw*32+xw,PEEK(string+a) ADD xw,dx ADD yw,dy NEXT a RETURN END PROCEDURE ' Feststellen, ob ein Feld frei ist für das Wort FUNCTION feldfrei(x,y) IF x<0 OR x>31 OR y<0 OR y>19 THEN RETURN 0 END IF IF PEEK(feld+y*32+x) THEN RETURN 0 END IF RETURN TRUE END FUNCTION ' PROCEDURE gets(c) ' ' Diese Subroutine/Prozedur sucht den gewünschten String in der Tabelle ' namens "woerter" und übernimmt ihn in den Stringbuffer. Die Länge des ' Strings wird in der Variable "lens" zurückgeliefert. PROCEDURE gets(c) w=0 WHILE c 'String in Tabelle suchen WHILE LOOKTABBYTE(woerter,w) ADD w,1 WEND ADD w,1 SUB c,1 WEND lens=0 WHILE LOOKTABBYTE(woerter,w) 'String Zeichen für Zeichen in Stringbuffer POKE string+lens,LOOKTABBYTE(woerter,w) ADD w,1 ADD lens,1 WEND RETURN END PROCEDURE ' Anzeige des Spielfeldes PROCEDURE anzeigen FOR b=0 TO 19 FOR a=0 TO 31 PUT PEEK(feld+b*32+a) NEXT a ? NEXT b RETURN END PROCEDURE ' --- Tabellen -------------------------------------------------------------- TABLE woerter BYTE "OPENMICRO",0,"OPENMINI",0,"OPENMIDI",0,"OPENMACRO",0,"OPENMAXI",0 "CCPLUS",0,"CCBASIC",0,"OCBASIC",0,"SCHNITTSTELLE",0,"ASSEMBLER",0 "FUNKTIONSUMFANG",0,"LEISTUNG",0 0 END TABLE ' --- Programmende --------------------------------------------------------- Passender Link: Offizielle Infosite zu den OM-Mikrocontrollern Meine Homepage: http://ccintern.dharlos.de |
| Antwort schreiben |