From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- app/misc-games/unknown/src/LINDWURM.ELA | 337 ++++++++++++++++++++++++ app/misc-games/unknown/src/SCHIFFEV.ELA | 424 +++++++++++++++++++++++++++++++ app/misc-games/unknown/src/SCHIFFEV2.ELA | 409 +++++++++++++++++++++++++++++ 3 files changed, 1170 insertions(+) create mode 100644 app/misc-games/unknown/src/LINDWURM.ELA create mode 100644 app/misc-games/unknown/src/SCHIFFEV.ELA create mode 100644 app/misc-games/unknown/src/SCHIFFEV2.ELA (limited to 'app/misc-games') diff --git a/app/misc-games/unknown/src/LINDWURM.ELA b/app/misc-games/unknown/src/LINDWURM.ELA new file mode 100644 index 0000000..57de114 --- /dev/null +++ b/app/misc-games/unknown/src/LINDWURM.ELA @@ -0,0 +1,337 @@ +PACKET lind wurm DEFINES lindwurm: +deklaration; +LET max = 500,zeilen = 23,spalten = 77; + +PROC kriech : + speicher := stelle; + REP + putline(""1"Punkte:"+text(punkte + bonus) + ""6""0""30"Zeit:" + zeit); + IF punkte <> 0 + THEN ende INCR 1; + IF ende > max THEN ende := 1 FI; + laenge := laenge + 1 - zaehler; + IF laenge > max THEN laenge := 1 FI; + wurm(ende) := speicher; + IF zaehler = 0 AND wurm(laenge) >= basis AND wurm(laenge) < (basis+(spalten*zeilen)) + THEN poke(wurm(laenge),leerzeichen) + FI; + IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) THEN + poke(speicher,char1) + FI + ELSE IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) + THEN poke (speicher,leerzeichen) + FI; + FI; + zaehler := 0; + speicher INCR richtung; + IF peek(speicher) <> leerzeichen THEN nahrung oder gift FI; + IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) THEN poke(speicher,char2) FI; + tastaturabfrage; + IF punkte > begrenzung THEN x := int(zeit); index := 1 FI; + IF zeit > stopzeit THEN index := 2 FI; + UNTIL index <> 0 PER +ENDPROC kriech; + +PROC nahrung oder gift : + IF peek(speicher) <> char 3 THEN index := 3 + ELSE punkte INCR 10; zaehler := 1 + FI; +ENDPROC nahrung oder gift; + +PROC tastaturabfrage : + taste := incharety(9 DIV geschwindigkeit); + feuer := taste = ""13""; + IF feuer THEN richtung := 0 + ELIF taste = ""10"" THEN richtung INCR spalten + ELIF taste = ""8"" THEN richtung DECR 1 + ELIF taste = ""2"" THEN richtung INCR 1 + ELIF taste = ""3"" THEN richtung DECR spalten + FI +ENDPROC tastatur abfrage; + +PROC bonus erreicht : + x := (int(stopzeit)-x) * schwierigkeit; + cspalte := 10; + czeile := 10; + cursorpositionieren; + putline("B O N U S ! ! !"); + line; + putline(""15" "+text(x)+" Punkte !!!"14""); + bonus := bonus + punkte + x; +ENDPROC bonus erreicht; + +PROC poke (INT CONST stelle,wert) : + INT VAR x pos := 1 + ((stelle - basis) MOD spalten), + y pos := 1 + ((stelle - basis) DIV spalten); + cursor(x pos,y pos); + IF wert = 126 THEN out(""15""8""14"") ELSE + out(code(wert)); + FI; + bildschirm (x pos)(y pos) := wert; +ENDPROC poke; + +INT PROC peek (INT CONST stelle) : + INT VAR x pos := 1 + ((stelle - basis) MOD spalten), + y pos := 1 + ((stelle - basis) DIV spalten); + bildschirm (x pos)(y pos) +ENDPROC peek; + +PROC cursorpositionieren : + bildschirm zeile := basis + spalten*czeile; + cursor(cspalte+1,czeile+1); +ENDPROC cursor positionieren; + +PROC highscore und platznummer : + punkte := punkte + bonus; + bonus := 0; + IF punkte > highscore THEN highscore := punkte FI; + player counter INCR 1; + q := player counter + 1; + spieler punkte(playercounter) := punkte; + FOR i FROM 1 UPTO playercounter REP + IF punkte > spielerpunkte (i) THEN q DECR 1 FI; + PER; + c spalte :=10; + czeile := 10; + cursorpositionieren; + putline("Hoechstpunktzahl "+text(highscore));line; + putline(" Punkte :"+text(punkte)); + putline(" Platznr.:"+text(q-1)); + IF q-1 >= 10 THEN inchar(hilf) + ELSE put("Name des Gewinners:"); + getline(hilf); + disablestop; + FOR i FROM playercounter DOWNTO q REP + spielername(i+1) := spielername(i); + IF iserror THEN clearerror; spielername(i+1) := "" FI; + PER; + enablestop; + spielername(q-1) := "(" +text(punkte) + " Punkte: " + hilf+")"; + FI; + page; + putline("Die ersten 10 Gewinner :"); + disablestop; + FOR i FROM 1 UPTO min(playercounter,10) REP + putline(text(i)+"."+spielername(i)); + IF iserror THEN clearerror;spielername(i) := "" FI + PER; + enablestop; + putline("Druecken Sie eine Taste"); + inchar(hilf); +ENDPROC highscore und platznummer; + +PROC explosion : + out(""7""); + FOR i FROM ende DOWNTO laenge +1REP + IF wurm (i) >= basis AND wurm(i) < (basis+spalten*zeilen) THEN poke(wurm(i),leerzeichen); + FI; + PER; + highscore und platznummer +ENDPROC explosion; + +PROC lindwurm : + bonus := 0; + + REP + clearscreen; + out(""14""1""4""); + IF bonus = 0 THEN neues spiel FI; + IF bonus > 0 THEN bonusspiel FI; + page; + rahmen; + lebensraum generieren; + lindwurm kopf setzen; + reset time; + kriech; + SELECT index OF + CASE 1 : bonus erreicht + CASE 2 : highscore und platznummer + CASE 3 : explosion + ENDSELECT + UNTIL bonus<= 0 COR no(""1""4""10""10"Noch ein Spiel") PER + +ENDPROC lindwurm; + +PROC neues spiel : + basis := 0; + stelle := basis + spalten*zeilen DIV 2; + schwierigkeit := 4; + geschwindigkeit :=9; + char 1:= 126; + char 2:= 79; + char 3:= 42; + char 4:= 124; + leerzeichen := 32; + index := 0; + ende := 0; + laenge := 0; + richtung := 0; + zaehler := 0; + bonus := 0; + punkte := 0; + stopzeit :="3:00"; + vorwahl; + begrenzung := 120 * schwierigkeit; +ENDPROC neues spiel; + +PROC liste aller spieler : + page; + FOR i FROM 1 UPTO playercounter REP + putline(text(i)+"."+spielername(i)); + IF i > 24 THEN pause(20) FI; + PER; + putline("ENDE"); + inchar(hilf); + page; +ENDPROC liste aller spieler; + + +PROC vorwahl : + spielregeln; + page; + REP + out(""1""); + putline(""142" Lindwurm "143""); + czeile :=12; + cspalte:=3; + cursorpositionieren; + putline("Schwierigkeitsgrad (1/2) "+ text(schwierigkeit,3)); + czeile :=14; + cspalte:=3; + cursorpositionieren; + putline("Geschwindigkeit (3/4) "+ text(geschwindigkeit,3)); + czeile :=16; + cspalte:=3; + cursorpositionieren; + putline("Liste aller Spieler (5) "); + czeile :=18; + cspalte:=3; + cursorpositionieren; + putline("Start mit RETURN"); + x := 0; + inchar(hilf); + IF hilf = ""13""THEN LEAVE vorwahl + ELIF hilf = "1" THEN schwierigkeit INCR 1 + ELIF hilf = "2" THEN schwierigkeit DECR 1 + ELIF hilf = "3" THEN geschwindigkeit INCR 1 + ELIF hilf = "4" THEN geschwindigkeit DECR 1 + ELIF hilf = "5" THEN liste aller spieler + ELSE out(""7"") + FI; + IF schwierigkeit > 26 THEN schwierigkeit := 1 + ELIF schwierigkeit < 1 THEN schwierigkeit := 26 FI; + IF geschwindigkeit > 9 THEN geschwindigkeit := 1 + ELIF geschwindigkeit < 1 THEN geschwindigkeit := 9 FI; + PER + +ENDPROC vorwahl; + +PROC spielregeln : + putline(code(char1)+" = Rahmen (Mauer)"); + line; + putline(code(char2)+" = Lindwurmkopf"); + line; + putline(code(char3)+" = Nahrung"); + line; + putline(""15""8""14" = Lindwurm"); + line; + putline(". = Gift"); + line; + putline ("Ziel des Spiels ist es, den Wurm mit Nahrung zu versorgen. Gift ist t”dlich."); + line; + putline ("Der Wurm kann mit den Pfeiltasten gesteuert werden. Wird eine Taste mehrmals"); + line; + putline ("gedrckt, wird der Wurm schneller. Vorsicht: Der Wurm darf nicht auf eine"); + line; + putline ("Mauer treffen. Mit jedem gefressenen Nahrungsteilchen wird der Wurm etwas"); + line; + putline ("l„nger. Du hast 3 Minuten Zeit, den Wurm zu fttern."); + line; + putline ("Viel Erfolg. Bitte drcke jetzt eine Taste."); + pause(6000); +ENDPROC spielregeln; + +PROC bonusspiel : + stelle := basis+zeilen*spaltenDIV2; + index := 0; + punkte := 0; + richtung := 0; + zaehler := 0; + ende := 0; + laenge := 0; + schwierigkeit INCR 1; + IF schwierigkeit > 26 THEN schwierigkeit := 26 FI; + begrenzung := 120 * schwierigkeit + +ENDPROC bonusspiel; + +PROC lebensraum generieren : + FOR i FROM 1 UPTO 16 * schwierigkeit REP + REP + x := int(random * real((zeilen-2)*spalten) + real(spalten)); + UNTIL peek(basis+x) = leerzeichen PER; + poke(basis+x,char3) + PER; + FOR i FROM 1 UPTO schwierigkeit REP + REP + x := int(random * real((zeilen-2)*spalten) + real(spalten)); + UNTIL peek(basis+x) = leerzeichen PER; + poke(basis+x,46) + PER; +ENDPROC lebensraum generieren; + +PROC lindwurmkopf setzen : + WHILE peek(stelle) <> leerzeichen REP stelle INCR 1 PER; + poke(stelle,char2); + out(""7""); + +ENDPROC lindwurmkopf setzen; + +PROC rahmen : + FOR i FROM basis UPTO basis + spalten-1 REP + poke(i,char4); + poke(i+(zeilen-1)*spalten,char4); + PER; + i := basis + spalten; + REP poke(i ,char4); + poke(i+spalten-1,char4); + i INCR spalten + UNTIL i >( basis + (zeilen-1)*spalten )PER + +ENDPROC rahmen; + +PROC clearscreen : + INT VAR x,y; + putline ("Nun markiert der Wurm sein Revier."); + line ; + put("Es ist");put(spalten);put("qm gross.");line; + FOR x FROM 1 UPTO spalten REP + cout(x); + FOR y FROM 1 UPTO zeilen REP + bildschirm(x)(y) := leerzeichen + PER + PER +ENDPROC clearscreen; + +TEXT PROC zeit : + subtext(time(clock(1)-uhr),5,8) +ENDPROC zeit; + +PROC reset time : + uhr := clock(1) +ENDPROC reset time;. + +deklaration : + ROW spalten ROW zeilen INT VAR bildschirm; + ROW 300 INT VAR spielerpunkte; + ROW 300 TEXT VAR spielername; + ROW max INT VAR wurm; + TEXT VAR hilf,taste,stopzeit; + INT VAR basis:=0,playercounter:=0,highscore:=0,q:=0,i:=0,x:=0,y:=0,stelle:=1000,richtung, + punkte:=0,bonus:=0,index:=0,cspalte,czeile,bildschirmzeile,zaehler:=0,ende:=0, + laenge:=0,speicher:=1,leerzeichen:=32,begrenzung:=480,schwierigkeit:=4, + geschwindigkeit:=9,c:=90,char1:=90,char2:=90,char3:=90,char4:=90; + + REAL VAR uhr; + BOOL VAR feuer; +ENDPACKET lindwurm diff --git a/app/misc-games/unknown/src/SCHIFFEV.ELA b/app/misc-games/unknown/src/SCHIFFEV.ELA new file mode 100644 index 0000000..2979a2c --- /dev/null +++ b/app/misc-games/unknown/src/SCHIFFEV.ELA @@ -0,0 +1,424 @@ + (* M.Staubermann,15.03.83 *) + +PACKET schiffe versenken DEFINES schiffe versenken : + + +(* D E K L A R A T I O N S T E I L *) + + +TEXT VAR eingabe, mitteilung := ""; +INT VAR x pos, y pos, reply; +BOOL VAR spieler 1, dran; +ROW 5 INT VAR count := ROW 5 INT : (0,0,0,0,0); +DATASPACE VAR ds; +forget(ds); +ds := nilspace; +BOUND TEXT VAR msg := ds; +CONCR(msg) := ""; +TASK VAR gegner,source; +forget(ds); +ds:=nilspace; +BOUND STRUCT (INT x , y) VAR schuss := ds; +forget(ds); +CONCR(schuss).x:= 1; +CONCR(schuss).y := 1; +ROW 11 ROW 17 TEXT VAR spielfeld; +LET mark begin = ""15"", + mark end = ""14"", + return = ""13"", + down = ""10"", + back = ""8"", + bell = ""7"", + up = ""3"", + vor = ""2"", + blank = " ", + nil = "", + schiffstypen= "5:F4:K3:S2:V1:P"; + +(* Ende des Deklarationsteils *) + + + +PROC schiffe versenken : + command dialogue(TRUE); + REP + IF no("Sind die Spielregeln bekannt") THEN page; + gib die spielregeln aus; + pause(200); + FI; + page; + line(6); + putline(" ABCDEFGH"); + putline(" +--------+"); + putline("1| |"); + putline("2| |"); + putline("3| |"); + putline("4| |"); + putline("5| |"); + putline("6| |"); + putline("7| |"); + putline("8| |"); + putline(" +--------+"); + putline(" Spielfeld"); + cursor(20,1); + putline("S c h i f f e v e r s e n k e n : "); + spiel ausfuehren;page + UNTIL no("Noch ein Spiel") PER +END PROC schiffe versenken; + + + +PROC gib die spielregeln aus: + cursor(15,2); + putline("DIE SPIELREGELN :"); + cursor(15,3); + putline("Es gibt fuenf Schiffstypen mit verschieden Laengen, die beim"); + cursor(15,4); + putline("""Gegner"" versenkt werden muessen.Er versenkt sie hier.Dazu"); + cursor(15,5); + putline("geht man mit dem Cursor an die entsprechende Stelle im Spiel -"); + cursor(15,6); + putline("feld und gibt zuerst die Position der Schiffe(waagerecht und "); + cursor(15,7); + putline("senkrecht) ein und waehrend des Spiels die Position, an der "); + cursor(15,8); + putline("ein gegnerisches Schiff vermutet wird. Ein Signal ertoent, "); + cursor(15,9); + putline("wenn man getroffen hat.Von jedem Schiffstyp ist nur ein Schiff"); + cursor(15,10); + putline("erlaubt.Beenden des Spiels mit 'E'. Schiessen mit ."); + cursor(3,9); +END PROC gib die spielregeln aus; + + + + +PROC botschaft (TEXT CONST message , TEXT CONST darstellen): + forget(ds); + ds := nilspace; + msg := ds; + CONCR(msg) := message; + REP send(gegner,0,ds,reply) UNTIL reply = 0 PER; + IF NOT (darstellen = "") THEN cursor(1,21); + putline(darstellen); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9) + FI +END PROC botschaft; + + + +PROC empfang (TEXT VAR message , BOOL CONST darstellen) : + forget(ds); + ds := nilspace; + REP wait (ds,reply,source) UNTIL (reply = 0) AND (source=gegner) + PER; + msg := ds; + message := CONCR(msg); + forget(ds); + IF darstellen THEN cursor(1,21); + putline(message); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9) + FI +END PROC empfang; + + + +PROC darstellen (TEXT CONST message) : + cursor(1,21); + putline(message); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9); +END PROC darstellen; + + + +PROC spiel ausfuehren : + forget(ds); + ds := nilspace; + msg := ds; + forget(ds); + ds := nilspace; + schuss := ds; + forget(ds); + cursor(1,20); + putline(mark begin + 28 * blank + "Info an den Spieler" + 28 * blank + + mark end); + cursor(1,21); + put("Task - Name des Mitspielers : "); + getline(eingabe); + IF exists(task(eingabe)) AND NOT (task (eingabe) + = myself) AND NOT (channel(task(eingabe)) < 0) + THEN gegner := task(eingabe); + putline("Er sitzt an Terminal " + text (channel(gegner))); + pause(100); + cursor(1,22); + leerzeile; + cursor(1,21); + leerzeile; + ELSE putline("Unerlaubter Task - Name !"); + pause(100); + LEAVE spiel ausfuehren + FI; + darstellen("Mit dem Partner vereinbaren , wer beginnt."); + cursor(1,21); + spieler 1 := yes("Faengt der Spieler an, der an diesem Terminal sitzt"); + cursor(1,21); + pause(10); + leerzeile; + IF spieler 1 THEN botschaft (name(myself) + " faengt an !",""); + ELSE empfang(mitteilung, TRUE) + FI; + dran := spieler 1; + cursor(15,14); + putline("Schiffstypen sind :"); + cursor(15,15); + putline("Flugzeugtraeger : FFFFF"); + cursor(15,16); + putline("Kreuzer : KKKK"); + cursor(15,17); + putline("Schnellboote : SSS"); + cursor(15,18); + putline("Versorger : VV"); + cursor(15,19); + putline("Paddelboote : P"); + cursor(3,9); + eingabe der schiffe; + spiele eine runde; +END PROC spiel ausfuehren; + + + +PROC eingabe der schiffe : + count := ROW 5 INT : (0,0,0,0,0); + FOR y pos FROM 8 UPTO 17 REP + FOR x pos FROM 2 UPTO 11 REP + spielfeld[ x pos] [y pos] := "" + PER + PER; + darstellen("Positionieren Sie den Cursor auf die entsprechende Position innerhalb des"); + darstellen("Spielfeldes und druecken Sie (mit ) die Buchstaben , so dass alle"); + darstellen("Schiffe auf dem Spielfeld sind."); + REP + inchar(eingabe); + getcursor(x pos , y pos); + IF NOT randbegrenzung ueberschritten THEN + IF eingabe = "E" THEN IF spieler 1 THEN + botschaft(name(myself) + "hoert auf","Spiel beendet"); + ELSE darstellen("Spiel beendet.") + FI; + LEAVE eingabe der schiffe + ELIF eingabe = "F" THEN wenn moeglich vergroessere("F") + ELIF eingabe = "K" THEN wenn moeglich vergroessere("K") + ELIF eingabe = "S" THEN wenn moeglich vergroessere("S") + ELIF eingabe = "V" THEN wenn moeglich vergroessere("V") + ELIF eingabe = "P" THEN wenn moeglich vergroessere("P") + ELIF eingabe = " " THEN loesche position + ELIF eingabe = "?" THEN gib die spielregeln aus + ELIF (eingabe = back) OR (eingabe = vor) OR (eingabe = down) + OR (eingabe = up) THEN out(eingabe) + ELSE out(bell) + FI + ELSE out(bell) + FI + UNTIL alle schiffe eingegeben PER. + + + loesche position : + out(" ");out(""8""); + IF NOT (spielfeld [x pos] [y pos] = "") THEN count[int(schiffstypen + SUB (pos(schiffstypen,spielfeld[x pos][y pos])-2))] DECR 1 + FI; + spielfeld [x pos] [y pos] := "". + + + + + alle schiffe eingegeben : + (count [5] = 5) CAND (count [4] = 4) CAND (count [3] = 3) CAND + (count [2] = 2) CAND (count [1] = 1). + + +END PROC eingabe der schiffe; + + + + BOOL PROC randbegrenzung ueberschritten : + ((eingabe = back) CAND (x pos <= 3)) COR ((eingabe = vor) CAND (x pos >= + 10)) COR ((eingabe = down) CAND (y pos >= 16)) COR ((eingabe = up) CAND + (y pos <= 9)) + +END PROC randbegrenzung ueberschritten; + + + +PROC wenn moeglich vergroessere (TEXT CONST schiff) : + IF ((schiff = "F") AND (count [5] < 5)) COR ((schiff = "K") AND + (count [4] < 4)) COR ((schiff = "S") AND (count [3] < 3)) COR + ((schiff = "V") AND (count [2] < 2)) COR ((schiff = "P") AND + (count [1] = 0)) + THEN IF waagerechter oder senkrechter nachbar AND NOT diagonaler nachbar + OR(count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))]=0) + AND noch kein schiff da + THEN count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))] + INCR 1; + out(schiff + ""8""); + spielfeld [x pos] [y pos] :=schiff + FI + FI. + + + + waagerechter oder senkrechter nachbar : + ((spielfeld [sub x(x pos - 1)] [y pos] = schiff) OR + (spielfeld [sub x(x pos + 1)] [y pos] = schiff))XOR + ((spielfeld [x pos] [sub y(y pos - 1)] = schiff) OR + (spielfeld [x pos] [sub y(y pos + 1)] = schiff)). + + + + diagonaler nachbar : + (spielfeld [sub x(x pos + 1)] [sub y(y pos + 1)] = schiff) OR + (spielfeld [sub x(x pos + 1)] [sub y(y pos - 1)] = schiff) OR + (spielfeld [sub x(x pos - 1)] [sub y(y pos + 1)] = schiff) OR + (spielfeld [sub x(x pos - 1)] [sub y(y pos - 1)] = schiff) . + + + + noch kein schiff da : + IF spielfeld[x pos] [y pos] <> "" THEN out(bell);FALSE ELSE TRUE FI. + +END PROC wenn moeglich vergroessere; + + + +INT PROC sub x(INT CONST subscription): + IF subscription > 11 THEN 11 + ELIF subscription < 2 THEN 2 + ELSE subscription + FI + +END PROC sub x; + + + +INT PROC sub y(INT CONST subscription): + IF subscription > 17 THEN 17 + ELIF subscription < 8 THEN 8 + ELSE subscription + FI + +END PROC sub y; + + + +PROC spiele eine runde : + IF spieler 1 THEN botschaft(name(myself)+" hat alle Schiffe eingegeben." + , "Eingabe der Schiffe beendet.") + ELSE empfang(mitteilung , TRUE) + FI; + REP + IF dran THEN darstellen("Jetzt schiessen !"); + abschiessen + ELSE rufe gegner + FI; + dran := NOT dran; + UNTIL kein schiff mehr da PER; + gegner hat verloren . + + + + kein schiff mehr da : + (count [5] = 0) CAND (count [4] = 0) CAND (count [3] = 0) CAND + (count [2] = 0) CAND (count [1] = 0). + + + + abschiessen : + REP + inchar(eingabe); + getcursor(x pos, y pos); + IF NOT randbegrenzung ueberschritten THEN + IF eingabe = "E" THEN IF spieler 1 THEN + botschaft(name(myself)+" hoert auf.","Spiel beendet."); + ELSE darstellen ("Spiel beendet.") FI; + LEAVE spiele eine runde + ELIF eingabe = return THEN schuss gegner; + forget(ds); + ds := nilspace; + CONCR(schuss).x := x pos; + CONCR(schuss).y := y pos; + schuss := ds; + REP send (gegner,0,ds,reply) + UNTIL reply = 0 PER; + empfang(mitteilung,TRUE); + ELIF eingabe = "?" THEN gib die spielregeln aus + ELIF (eingabe = back) OR (eingabe = vor) OR (eingabe = up) + OR (eingabe = down) THEN out(eingabe) + ELSE out(bell) + FI + ELSE out(bell) + FI + UNTIL eingabe = return PER. + + + + elem : + spielfeld [sub x(CONCR(schuss).x)] [sub y(CONCR(schuss).y)]. + + + + gegner hat verloren : + botschaft("gegner hat verloren","Sie haben gewonnen.Herzlichen Glueckwunsch meinerseits !"). + + + schuss gegner : + botschaft("gegner schiesst",""). + + + + rufe gegner : + empfang(mitteilung,FALSE); + IF mitteilung = "gegner schiesst" THEN forget(ds); + ds := nilspace; + REP wait(ds,reply,source) + UNTIL (reply = 0) AND (source + = gegner) PER; + schuss := ds; + IF elem <> "" THEN + count[int(schiffstypen SUB + (pos(schiffstypen,elem)- 2 + ))] DECR 1; + cursor(CONCR(schuss).x, + CONCR(schuss).y); + out(" "); + IF count[int(schiffstypen SUB (pos(schiff + stypen,elem) - 2))] = 0 + THEN botschaft(elem + " versenkt" + + bell, "") + ELSE botschaft(elem + " getroffen" + + bell,"") + FI; + elem := "" + ELSE botschaft("nicht getroffen","") + FI;forget(ds) + ELIF mitteilung = "gegner hat verloren" THEN + botschaft("Spiel beendet", + "Sie haben verloren.Tut mir leid."); + LEAVE spiele eine runde + ELSE darstellen(mitteilung) + FI +END PROC spiele eine runde. + + +leerzeile : + 77 TIMESOUT blank + +END PACKET schiffe versenken diff --git a/app/misc-games/unknown/src/SCHIFFEV2.ELA b/app/misc-games/unknown/src/SCHIFFEV2.ELA new file mode 100644 index 0000000..a4b8b0b --- /dev/null +++ b/app/misc-games/unknown/src/SCHIFFEV2.ELA @@ -0,0 +1,409 @@ + (* M.Staubermann,15.03.83 *) + (* Korr. 24.05.87 *) +PACKET schiffe versenken DEFINES schiffe versenken : + + +(* D E K L A R A T I O N S T E I L *) + + +TEXT VAR eingabe, mitteilung := ""; +INT VAR x pos, y pos, reply; +BOOL VAR spieler 1, dran; +ROW 5 INT VAR count := ROW 5 INT : (0,0,0,0,0); +DATASPACE VAR ds; +forget(ds); +ds := nilspace; +BOUND TEXT VAR msg := ds; +CONCR(msg) := ""; +TASK VAR gegner,source; +forget(ds); +ds:=nilspace; +BOUND STRUCT (INT x , y) VAR schuss := ds; +forget(ds); +CONCR(schuss).x:= 1; +CONCR(schuss).y := 1; +ROW 11 ROW 17 TEXT VAR spielfeld; +LET mark begin = ""15"", + mark end = ""14"", + return = ""13"", + down = ""10"", + back = ""8"", + bell = ""7"", + up = ""3"", + vor = ""2"", + blank = " ", + schiffstypen= "5:F4:K3:S2:V1:P"; + +(* Ende des Deklarationsteils *) + + + +PROC schiffe versenken : + command dialogue(TRUE); + REP + IF no("Sind die Spielregeln bekannt") THEN page; + gib die spielregeln aus; + pause(200); + FI; + page; + line(6); + putline(" ABCDEFGH"); + putline(" +--------+"); + putline("1| |"); + putline("2| |"); + putline("3| |"); + putline("4| |"); + putline("5| |"); + putline("6| |"); + putline("7| |"); + putline("8| |"); + putline(" +--------+"); + putline(" Spielfeld"); + cursor(20,1); + putline("S c h i f f e v e r s e n k e n : "); + spiel ausfuehren;page + UNTIL no("Noch ein Spiel") PER +END PROC schiffe versenken; + + + +PROC gib die spielregeln aus: + cursor(15,2); + putline("DIE SPIELREGELN :"); + cursor(15,3); + putline("Es gibt fnf Schiffstypen mit verschieden L„ngen, die beim"); + cursor(15,4); + putline("""Gegner"" versenkt werden mssen. Er versenkt sie hier. Dazu"); + cursor(15,5); + putline("geht man mit dem Cursor an die entsprechende Stelle im Spiel-"); + cursor(15,6); + putline("feld und gibt zuerst die Position der Schiffe (waagerecht und"); + cursor(15,7); + putline("senkrecht) ein und w„hrend des Spiels die Position an der "); + cursor(15,8); + putline("ein gegnerisches Schiff vermutet wird. Ein Signal ert”nt,"); + cursor(15,9); + putline("wenn man getroffen hat. Von jedem Schiffstyp ist nur ein Schiff"); + cursor(15,10); + putline("erlaubt. Beenden des Spiels mit 'E'. Schieįen mit ."); + cursor(3,9); +END PROC gib die spielregeln aus; + + + + +PROC botschaft (TEXT CONST message , TEXT CONST darstellen): + forget(ds); + ds := nilspace; + msg := ds; + CONCR(msg) := message; + REP send(gegner,0,ds,reply) UNTIL reply = 0 PER; + IF NOT (darstellen = "") THEN cursor(1,21); + putline(darstellen); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9) + FI +END PROC botschaft; + + + +PROC empfang (TEXT VAR message , BOOL CONST darstellen) : + forget(ds); + ds := nilspace; + REP wait (ds,reply,source) UNTIL (reply = 0) AND (source=gegner) + PER; + msg := ds; + message := CONCR(msg); + forget(ds); + IF darstellen THEN cursor(1,21); + putline(message); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9) + FI +END PROC empfang; + + + +PROC darstellen (TEXT CONST message) : + cursor(1,21); + leerzeile ; + putline(message); + pause(50); + cursor(3,9); +END PROC darstellen; + + + +PROC spiel ausfuehren : + forget(ds); + ds := nilspace; + msg := ds; + forget(ds); + ds := nilspace; + schuss := ds; + forget(ds); + cursor(1,20); + putline(mark begin + 28 * blank + "Info an den Spieler" + 28 * blank + + mark end); + cursor(1,21); + put("Task - Name des Mitspielers : "); + getline(eingabe); + IF exists task(eingabe) AND NOT (task (eingabe) + = myself) AND NOT (channel(task(eingabe)) <= 0) + THEN gegner := task(eingabe); + putline("Er sitzt an Terminal " + text (channel(gegner))); + pause(100); + cursor(1,22); + leerzeile; + cursor(1,21); + leerzeile; + ELSE putline("Unerlaubter Task - Name !"); + pause(100); + LEAVE spiel ausfuehren + FI; + darstellen("Mit dem Partner vereinbaren, wer beginnt."); + cursor(1,21); + spieler 1 := yes("Faengt der Spieler an, der an diesem Terminal sitzt"); + cursor(1,21); + pause(10); + leerzeile; + IF spieler 1 THEN botschaft (name(myself) + " faengt an !",""); + ELSE empfang(mitteilung, TRUE) + FI; + dran := spieler 1; + cursor(15,14); + putline("Schiffstypen sind :"); + cursor(15,15); + putline("Flugzeugtraeger : FFFFF"); + cursor(15,16); + putline("Kreuzer : KKKK"); + cursor(15,17); + putline("Schnellboote : SSS"); + cursor(15,18); + putline("Versorger : VV"); + cursor(15,19); + putline("Paddelboote : P"); + cursor(3,9); + eingabe der schiffe; + spiele eine runde; +END PROC spiel ausfuehren; + + + +PROC eingabe der schiffe : + count := ROW 5 INT : (0,0,0,0,0); + FOR y pos FROM 8 UPTO 17 REP + FOR x pos FROM 2 UPTO 11 REP + spielfeld[ x pos] [y pos] := "" + PER + PER; + darstellen("Positionieren Sie den Cursor auf die entsprechende Position innerhalb des"); + darstellen("Spielfeldes und drcken Sie (mit ) die Buchstaben, so daį alle"); + darstellen("Schiffe auf dem Spielfeld sind."); + REP + inchar(eingabe); + getcursor(x pos , y pos); + IF eingabe = "E" THEN IF spieler 1 THEN + botschaft(name(myself) + "hoert auf","Spiel beendet"); + ELSE darstellen("Spiel beendet.") + FI; + LEAVE eingabe der schiffe + ELIF eingabe = "F" THEN wenn moeglich vergroessere("F") + ELIF eingabe = "K" THEN wenn moeglich vergroessere("K") + ELIF eingabe = "S" THEN wenn moeglich vergroessere("S") + ELIF eingabe = "V" THEN wenn moeglich vergroessere("V") + ELIF eingabe = "P" THEN wenn moeglich vergroessere("P") + ELIF eingabe = " " THEN loesche position + ELIF eingabe = "?" THEN gib die spielregeln aus + ELIF (eingabe = back) AND x pos > 3 THEN out (back) + ELIF (eingabe = vor) AND x pos < 10 THEN out (vor) + ELIF (eingabe = down) AND y pos < 16 THEN out (down) + ELIF (eingabe = up) AND y pos > 9 THEN out(up) + FI + UNTIL alle schiffe eingegeben PER. + + + loesche position : + out(" ");out(""8""); + IF NOT (spielfeld [x pos] [y pos] = "") THEN count[int(schiffstypen + SUB (pos(schiffstypen,spielfeld[x pos][y pos])-2))] DECR 1 + FI; + spielfeld [x pos] [y pos] := "". + + + + + alle schiffe eingegeben : + (count [5] = 5) CAND (count [4] = 4) CAND (count [3] = 3) CAND + (count [2] = 2) CAND (count [1] = 1). + + +END PROC eingabe der schiffe; + + + +PROC wenn moeglich vergroessere (TEXT CONST schiff) : + IF ((schiff = "F") AND (count [5] < 5)) COR ((schiff = "K") AND + (count [4] < 4)) COR ((schiff = "S") AND (count [3] < 3)) COR + ((schiff = "V") AND (count [2] < 2)) COR ((schiff = "P") AND + (count [1] = 0)) + THEN IF waagerechter oder senkrechter nachbar AND NOT diagonaler nachbar + OR(count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))]=0) + AND noch kein schiff da + THEN count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))] + INCR 1; + out(schiff + ""8""); + spielfeld [x pos] [y pos] :=schiff + FI + FI. + + + + waagerechter oder senkrechter nachbar : + ((spielfeld [sub x(x pos - 1)] [y pos] = schiff) OR + (spielfeld [sub x(x pos + 1)] [y pos] = schiff))XOR + ((spielfeld [x pos] [sub y(y pos - 1)] = schiff) OR + (spielfeld [x pos] [sub y(y pos + 1)] = schiff)). + + + + diagonaler nachbar : + (spielfeld [sub x(x pos + 1)] [sub y(y pos + 1)] = schiff) OR + (spielfeld [sub x(x pos + 1)] [sub y(y pos - 1)] = schiff) OR + (spielfeld [sub x(x pos - 1)] [sub y(y pos + 1)] = schiff) OR + (spielfeld [sub x(x pos - 1)] [sub y(y pos - 1)] = schiff) . + + + + noch kein schiff da : + IF spielfeld[x pos] [y pos] <> "" THEN out(bell);FALSE ELSE TRUE FI. + +END PROC wenn moeglich vergroessere; + + + +INT PROC sub x(INT CONST subscription): + IF subscription > 11 THEN 11 + ELIF subscription < 2 THEN 2 + ELSE subscription + FI + +END PROC sub x; + + + +INT PROC sub y(INT CONST subscription): + IF subscription > 17 THEN 17 + ELIF subscription < 8 THEN 8 + ELSE subscription + FI + +END PROC sub y; + + + +PROC spiele eine runde : + IF spieler 1 THEN botschaft(name(myself)+" hat alle Schiffe eingegeben." + , "Eingabe der Schiffe beendet.") + ELSE empfang(mitteilung , TRUE) + FI; + REP + IF dran THEN darstellen("Jetzt schiessen !"); + abschiessen + ELSE rufe gegner + FI; + dran := NOT dran; + UNTIL kein schiff mehr da PER; + gegner hat verloren . + + + + kein schiff mehr da : + (count [5] = 0) CAND (count [4] = 0) CAND (count [3] = 0) CAND + (count [2] = 0) CAND (count [1] = 0). + + + + abschiessen : + REP + inchar(eingabe); + getcursor(x pos, y pos); + IF eingabe = "E" THEN IF spieler 1 THEN + botschaft(name(myself)+" hoert auf.","Spiel beendet."); + ELSE darstellen ("Spiel beendet.") FI; + LEAVE spiele eine runde + ELIF eingabe = return THEN schuss gegner; + forget(ds); + ds := nilspace; + CONCR(schuss).x := x pos; + CONCR(schuss).y := y pos; + schuss := ds; + REP send (gegner,0,ds,reply) + UNTIL reply = 0 PER; + empfang(mitteilung,TRUE); + ELIF eingabe = "?" THEN gib die spielregeln aus + ELIF (eingabe = back) AND x pos > 3 THEN out (back) + ELIF (eingabe = vor) AND x pos < 10 THEN out (vor) + ELIF (eingabe = down) AND y pos < 16 THEN out (down) + ELIF (eingabe = up) AND y pos > 9 THEN out(up) + FI + UNTIL eingabe = return PER. + + + + elem : + spielfeld [sub x(CONCR(schuss).x)] [sub y(CONCR(schuss).y)]. + + + + gegner hat verloren : + botschaft("gegner hat verloren","Sie haben gewonnen.Herzlichen Glueckwunsch meinerseits !"). + + + schuss gegner : + botschaft("gegner schiesst",""). + + + + rufe gegner : + empfang(mitteilung,FALSE); + IF mitteilung = "gegner schiesst" THEN forget(ds); + ds := nilspace; + REP wait(ds,reply,source) + UNTIL (reply = 0) AND (source + = gegner) PER; + schuss := ds; + IF elem <> "" THEN + count[int(schiffstypen SUB + (pos(schiffstypen,elem)- 2 + ))] DECR 1; + cursor(CONCR(schuss).x, + CONCR(schuss).y); + out(" "); + IF count[int(schiffstypen SUB (pos(schiff + stypen,elem) - 2))] = 0 + THEN botschaft(elem + " versenkt" + + bell, "") + ELSE botschaft(elem + " getroffen" + + bell,"") + FI; + elem := "" + ELSE botschaft("nicht getroffen","") + FI;forget(ds) + ELIF mitteilung = "gegner hat verloren" THEN + botschaft("Spiel beendet", + "Sie haben verloren. Tut mir leid."); + LEAVE spiele eine runde + ELSE darstellen(mitteilung) + FI +END PROC spiele eine runde ; + + +.leerzeile : + out (""5"") + +END PACKET schiffe versenken -- cgit v1.2.3