¢¢; ---------------------------------¢; FRAGE-ANTWORT SPIEL ¢; (C) 1987 BY ACTION USER GROUP¢; WRITTEN BY MARKUS KRETZER¢; ---------------------------------¢¢¢; BINARY I/O ¢; EQUATES¢¢DEFINE IOCB="$340",¢ IOCBNR="16" ; ALWAYS CH#1¢BYTE POINTER ICCOM, ; =$342¢ ICSTA, ; =$343¢ ICAUX1, ; =$34A¢ ICAUX2 ; =$34B¢CARD POINTER ICBADR, ; =$344 ¢ ICBLEN ; =$348¢¢PROC CIOMYMY=$E456(BYTE AKKU,XREG) RETURN¢PROC BIO(BYTE CHANNEL ¢ CARD ADRESS,LENGHTH¢ BYTE COMMAND)¢ CHANNEL==LSH 4¢¢ ICCOM=$342 ICCOM==+CHANNEL¢ ICCOM^=COMMAND¢¢ ICBADR=$344 ICBADR==+CHANNEL¢ ICBADR^=ADRESS¢¢ ICBLEN=$348 ICBLEN==+CHANNEL¢ ICBLEN^=LENGHTH¢¢ CIOMYMY(0,CHANNEL)¢RETURN¢¢PROC BPUT(BYTE CHANNEL¢ CARD ADRESS,LENGHTH)¢ BIO(CHANNEL,ADRESS,LENGHTH,11)¢RETURN¢¢PROC BGET(BYTE CHANNEL¢ CARD ADRESS,LENGHTH)¢ BIO(CHANNEL,ADRESS,LENGHTH,7)¢RETURN¢¢PROC XIO(BYTE CHANNEL,DUMMY,¢ COMMAND,AUX1,AUX2 ¢ CARD FILADR)¢ CHANNEL==LSH 4¢¢ ICCOM=$342 ICCOM==+CHANNEL¢ ICCOM^=COMMAND¢¢ ICBADR=$344 ICBADR==+CHANNEL¢ ICBADR^=FILADR¢¢ ICAUX1=$34A ICAUX1==+CHANNEL¢ ICAUX1^=AUX1¢¢ ICAUX2=$34B ICAUX2==+CHANNEL¢ ICAUX2^=AUX2¢¢ CIOMYMY(0,CHANNEL)¢RETURN¢¢; ---------------------------------¢ MODULE¢; ---------------------------------¢¢TYPE QUEST=[BYTE ANSWER, ¢ FRAGEN] ¢¢DEFINE QUESTSIZE="241",¢ FRAGENSIZE="1",MAXSPACE="5000",¢ RICHTIG="1",FALSCH="0"¢¢BYTE ARRAY QUESTIONS(MAXSPACE),¢ C_QUESTION(240),¢ cc_quest(60),¢ filespec(20) ¢CARD RECCOUNT=[0]¢BYTE REPLY,¢ RICHTIG_ZAEHLER,FALSCH_ZAEHLER¢¢byte array farbe(0)=708¢¢PROC CLR(byte acol) PUT(125) ¢ farbe(2)=acol¢RETURN¢¢PROC TITLE()¢ PRINTE(" ------------------------------------")¢ PRINTE(" | Frage-Antwort Spiel Version 1.00 |")¢ PRINTE(" | (C) 1987 by Action User Group |")¢;Printe(" | written in Action! |")¢ Printe(" | written in Action! by M.K |")¢ PRINTE(" ------------------------------------")¢RETURN¢¢PROC Wait_KEY()¢ PRINTe("Druecke eine Taste")¢ reply=getd(7)¢return¢¢BYTE FUNC FRAGEN_OUT(byte whichrec) ¢¢byte I,I2,I3,start,STOP,right_answer,¢ DIE_ANTWORT¢QUEST POINTER NEWRECORD¢BYTE POINTER FRAGENPTR¢ ¢ CLR() Farbe(2)=0¢¢ newrecord=questions+(whichrec*questsize)¢ right_answer=newrecord.answer¢¢ fragenptr=newrecord+fragensize¢ moveblock(c_question,fragenptr,240)¢ ¢ start=1 STOP=START+59¢ PRINTE("Frage :")¢ I3=START¢ DO¢ PUT(C_QUESTION(I3))¢ I3==+1¢ UNTIL I3=STOP OR C_QUESTION(I3)=155¢ OD¢ PUTE() PUTE()¢ START==+60 STOP==+60¢ PRINTE("moegliche Antworten :")¢ ¢ FOR I=2 TO 4¢ DO¢ PRINT("Antwort :") PRINTBE(I-1)¢ I3=START¢ DO¢ PUT(C_QUESTION(I3))¢ I3==+1¢ UNTIL I3=STOP OR C_QUESTION(I3)=155¢ OD¢ PUTE() PUTE()¢ START==+60 STOP==+60¢ OD¢¢ PUTE()¢¢ Printe("Welche Antwort ist richtig")¢ reply=getd(7)¢ if reply=right_answer then¢ PUTE()¢ PRINTE("***** פחבזקחודáIJמקתנפקáííí *****")¢ DIE_ANTWORT=RICHTIG¢ else¢ PRINTE("***** הIJכצבזדáIJמקתנפקáííí *****")¢ PUTE()¢ PRint("Die richtige Antwort war :")¢ put(right_answer)¢ DIE_ANTWORT=FALSCH¢ fi¢¢ PUTE()¢ wait_key()¢ ¢RETURN (DIE_ANTWORT)¢¢PROC EINGABE()¢byte I,I2,I3,start,STOP¢¢QUEST POINTER NEWRECORD¢¢BYTE POINTER FRAGENPTR¢¢ CLR() FARBE(2)=$60¢ ¢ FOR I= 0 TO 240 DO C_QUESTION(I)=' OD¢¢ PRINT("Frage Nr.:") PRINTce(reccount+1)¢PRINTE("Gebe Frage ein. (max. 60 Zeichen)")¢start=1 STOP=START+59¢¢ inputmd(0,cc_quest,60)¢ PUTE() PUTE()¢ ¢ SASSIGN(c_question,cc_quest,start,stOP)¢ start==+60 STOP==+60¢¢PRINTE("Gebe 3 Antworten ein. (max. 60 Zeichen pro Antwort)")¢¢ for i=2 to 4 ¢ do¢ PRINT("Antwort :") PRINTbE(i-1) ¢ inputmd(0,cc_quest,60)¢ PUTE() PUTE()¢ ¢ SASSIGN(c_question,cc_quest,start,stOP)¢ start==+60 STOP==+60¢ od¢¢do¢ do¢ PRINTE("Welche Antwort ist richtig???")¢ newrecord=questions+(reccount*questsize)¢ newrecord.answer=getd(7)¢ until newrecord.answer>='1 and newrecord.answer<='3¢ od¢ PUTE()¢ PRINT("Ist Frage ") ¢ put(newrecord.answer)¢ PRINTE(" richtig?") ¢ reply=getd(7)¢until reply='J or reply='j¢od¢fragenptr=newrecord+fragensize¢moveblock(fragenptr,c_question,240)¢reccount==+1¢return¢¢PROC AUSGABE()¢BYTE I¢¢if reccount>0 then¢do¢ clr($80)¢ PRINT("Welche Frage (1 bis ")¢ PRINTc(reccount) PRINT(") ?")¢ I=inputb() i==-1 ¢until I>=0 and I<reccount¢od¢ fragen_out(I)¢fi¢return¢¢PROC speichern()¢CARD i BYTE ak ¢ clr($32)¢ PRINTE("Speichern der Daten...")¢ PRINT("Geraet+filenamen >")¢ INPUTMD(0,filespec,15)¢ close(3) open(3,filespec,8,0)¢ PRINTE("Schreiben...bitte warten...")¢¢ ; Fileformat :¢ ; 1. Reccount¢ ; 2. Datenstring von 0 bis MAXSPACE¢¢ printcde(3,reccount)¢¢ BPUT(3,QUESTIONS,MAXSPACE)¢¢ close(3)¢return¢¢PROC LADEN()¢CARD i BYTE ak ¢ clr($A0)¢ PRINTE("LADEN der Daten...")¢ PRINT("Geraet+filenamen >")¢ INPUTMD(0,filespec,15)¢ close(3) open(3,filespec,4,0)¢ PRINTE("Laden...bitte warten...")¢¢ reccount=inputcd(3)¢¢ BGET(3,QUESTIONS,MAXSPACE)¢¢ close(3)¢return¢¢PROC WHOLE_DIRECTORY()¢¢ DO INPUTMD(2,FILESPEC,20) PRINTE(FILESPEC)¢ UNTIL EOF(2)=136¢ OD¢CLOSE (2) Wait_key()¢RETURN¢¢PROC DIR1()¢ CLR($FE) CLOSE (2) OPEN (2,("D:*.*"),6,0)¢ WHOLE_DIRECTORY()¢RETURN¢¢PROC DIR_RAMDISK()¢ CLR($DE) CLOSE (2) OPEN (2,("D8:*.*"),6,0)¢ WHOLE_DIRECTORY()¢RETURN¢¢PROC AUSWERTUNG()¢CLR($E0) TITLE()¢ PUTE() PUTE() PUTE() ¢PRINT("Richtige Antworten :")¢PRINTBE(RICHTIG_ZAEHLER)¢¢PRINT(" Falsche Antworten :")¢PRINTBE(FALSCH_ZAEHLER) ¢PUTE()¢WAIT_KEY()¢RETURN¢¢PROC ZUFALL() ¢BYTE I,WIEVIEL,WHICH¢ PUTE()¢ PRINT("Wieviele Fragen ??? (1 bis 255)")¢ WIEVIEL=INPUTB()¢¢ FOR I =1 TO WIEVIEL¢ DO¢ WHICH=RAND(RECCOUNT)¢ REPLY=FRAGEN_OUT(WHICH)¢ IF REPLY=1 THEN RICHTIG_ZAEHLER==+1¢ ELSE FALSCH_ZAEHLER==+1¢ FI¢ OD¢AUSWERTUNG()¢RETURN¢¢PROC REIHE_RUECK() ¢BYTE I¢¢RICHTIG_ZAEHLER=0¢ FALSCH_ZAEHLER=0¢¢ I=RECCOUNT-1¢ DO¢ REPLY=FRAGEN_OUT(I)¢ IF REPLY=1 THEN RICHTIG_ZAEHLER==+1¢ ELSE FALSCH_ZAEHLER==+1¢ FI¢ I==-1¢ UNTIL I=255¢ OD¢AUSWERTUNG()¢RETURN¢¢PROC REIHE_NACH() ¢BYTE I¢¢RICHTIG_ZAEHLER=0¢ FALSCH_ZAEHLER=0¢ ¢ FOR I=0 TO RECCOUNT-1¢ DO¢ REPLY=FRAGEN_OUT(I)¢ IF REPLY=1 THEN RICHTIG_ZAEHLER==+1¢ ELSE FALSCH_ZAEHLER==+1¢ FI¢ OD¢AUSWERTUNG()¢RETURN¢¢PROC GAME_INIT()¢IF RECCOUNT>0 THEN¢ ¢ CLR($F0) TITLE()¢ PUTE() PUTE() PUTE() ¢¢ PRINTE("1. zuf♪llig Abfragen")¢ PRINTE("2. der Reihe nach")¢ PRINTE("3. der Reihe nach, aber r
ckwaerts")¢ PRINTE("M. Hauptmen
")¢¢ REPLY=GETD(7)¢ IF REPLY='1 THEN ZUFALL() ¢ ELSE ¢ IF REPLY='2 THEN REIHE_NACH()¢ ELSE ¢ IF REPLY='3 THEN REIHE_RUECK()¢ FI¢ FI ¢ FI¢FI¢¢RETURN¢¢PROC LOESCHEN()¢¢ CLR($30) TITLE()¢ PUTE() PUTE() PUTE() ¢¢ PRINTE("Letzte Frage lschen ?")¢ REPLY=GETD(7)¢¢ IF REPLY='J or REPLY='j ¢ THEN ¢ IF RECCOUNT>0 THEN RECCOUNT==-1 FI¢ FI¢¢RETURN¢PROC MAIN() ¢close(7) open(7,"K:",4,0)¢POKE (82,0) graphics(0) ¢¢poke (756,204) ; int.Zeichen(nur XL,XE)¢¢do¢ clr($10) ¢ TITLE()¢ PUTE()¢ PRINTE("1. EINGABE von Fragen")¢ PRINTE("2. AUSGABE von bestimmten Fragen")¢ PRINTE("3. Das Spiel")¢ PRINTE("L. Laden") ¢ PRINTE("S. Speichern")¢ PRINTE("D. Directory")¢ PRINTE("R. Directory RAMDISK (D8:)")¢ PRINTE("E. Letzte Frage lschen")¢ PRINTE("X. Programm verlassen...")¢ PUTE()¢ PRINT("Fragen im Speicher :")¢ PRINTce(reccount)¢REPLY=GETD(7)¢¢IF REPLY='1 THEN EINGABE() FI¢IF REPLY='2 THEN AUSGABE() FI¢IF REPLY='3 THEN GAME_INIT() FI¢IF REPLY='S or REPLY='s THEN SPEICHERN() FI¢IF REPLY='L or REPLY='l THEN LADEN() FI¢IF REPLY='D or REPLY='d THEN DIR1() FI¢IF REPLY='R or REPLY='r THEN DIR_RAMDISK() FI¢IF REPLY='E or REPLY='e THEN LOESCHEN() FI¢IF REPLY='X or REPLY='x THEN EXIT FI¢OD¢RETURN¢¢
