Inhalt
Aktueller Ordner:
pascalstatus.pas
PROGRAM status;
(****************************************************************)
(* Paul Koop M.A. Netzhautsimulation *)
(* (vgl. MAHOWALD, M.A. MEAD, C. SdW7/91S.64ff) *)
(* Die Simulation wurde ursprunglich entwickelt, *)
(* um die Verwendbarkeit *)
(* von neuronalen Netzen (Achtung: nicht neuralen Netzen) *)
(* fuer die Algorithmisch Rekursive Sequanzanalyse *)
(* zu ueberpruefen *)
(* Modellcharakter hat allein der Quelltext. Eine Compilierung *)
(* dient nur als Falsifikationsversuch *)
(****************************************************************)
USES dos,crt;
(*-------------------------------------- Datenstruktur ---------*)
CONST
l = char(2);
lebendig = true;
cursor = white;
TYPE
s = 0..15;
raum = array(.1..80,1..24.) of s;
zahl = ^inhalt;
inhalt = RECORD
i:integer;
v:zahl;
n:zahl;
END;
VAR
a,b:raum;
n,x,y,xa,ya:zahl;
(*----------------------------------- Prozeduren ----------------*)
PROCEDURE aufbau;
VAR z:integer;
BEGIN
randomize;
z := 1;
new(n);
xa := n;
x := n;
x^.i := z;
REPEAT
z := z +1;
new(n);
x^.n := n;
n^.v := x;
x := n;
x^.i := z;
UNTIL z = 80;
x^.n := xa;
xa^.v := x;
z := 1;
new(n);
ya := n;
y := n;
y^.i := z;
REPEAT
z := z +1;
new(n);
y^.n := n;
n^.v := y;
y := n;
y^.i := z;
UNTIL z = 24;
y^.n := ya;
ya^.v := y;
END;
PROCEDURE abbaux(x:zahl);
BEGIN
IF x^.n <> xa THEN abbaux(x^.n);
dispose(x);
END;
PROCEDURE abbauy(y:zahl);
BEGIN
IF y^.n <> ya THEN abbauy(y^.n);
dispose(y);
END;
FUNCTION neu (VAR r:raum; VAR x,y:zahl):s;
VAR z:integer;
BEGIN
(* z := 0;
z:=z + r(.x^.v^.i,y^.v^.i.);
z:=z + r(.x^.i ,y^.v^.i.);
z:=z + r(.x^.n^.i,y^.v^.i.);
z:=z + r(.x^.v^.i,y^.i .);
z:=z + r(.x^.n^.i,y^.i .);
z:=z + r(.x^.v^.i,y^.n^.i.);
z:=z + r(.x^.i ,y^.n^.i.);
z:=z + r(.x^.n^.i,y^.n^.i.);
Z:= z div 8;
*)
z := 0;
z := z +
(
r(.x^.v^.v^.i,y^.v^.v^.i.)+r(.x^.v^.i,y^.v^.v^.i.)+r(.x^.i,y^.v^.v^.i.)+r(.x^.n^.i,y^.v^.v^.i.)+r(.x^.n^.n^.i,y^.v^.v^.i.)
+r(.x^.v^.v^.i,y^.v^.i.)+r(.x^.v^.i,y^.v^.i.)*2+r(.x^.i,y^.v^.i.)*2+r(.x^.n^.i,y^.v^.i.)*2+r(.x^.n^.n^.i,y^.v^.i.)
+r(.x^.v^.v^.i,y^.i.)+r(.x^.v^.i,y^.i.)*2+r(.x^.n^.i,y^.i.)*2+r(.x^.n^.n^.i,y^.i.)
+r(.x^.v^.v^.i,y^.n^.i.)+r(.x^.v^.i,y^.n^.i.)*2+r(.x^.i,y^.n^.i.)*2+r(.x^.n^.i,y^.n^.i.)*2+r(.x^.n^.n^.i,y^.n^.i.)
+r(.x^.v^.v^.i,y^.n^.n^.i.)+r(.x^.v^.i,y^.n^.n^.i.)+r(.x^.i,y^.n^.n^.i.)+r(.x^.n^.i,y^.n^.n^.i.)+r(.x^.n^.n^.i,y^.n^.n^.i.)
);
z := z div 32;
IF (r(.x^.i,y^.i.) = z)
THEN
neu := 0
ELSE
neu := abs(z-r(.x^.i,y^.i.))
END;
PROCEDURE text_anfang;
BEGIN
window(1,25,80,25);
textbackground(red);
textcolor(white);
clrscr;
write('Koop Editor <F10>Zufall <Pfeil>Cursor <Einfg>Reiz+ <Entf>Reiz- <Return>Start');
gotoxy(1,1);
textcolor(2);
textbackground(black);
window(1,1,80,24);clrscr;window(1,1,80,25);
END;
PROCEDURE text_ende;
BEGIN
gotoxy(1,25);
textbackground(red);
textcolor(white);
write('Koop Status <F1>neu <F2>Editieren <RETURN> Ende');
gotoxy(1,1);
textcolor(2);
textbackground(black);
END;
PROCEDURE zufall(VAR von:raum);
VAR x,y:integer;
BEGIN
gotoxy(1,1);
FOR y := 1 TO 24
DO
FOR x := 1 TO 80
DO
BEGIN
von(.x,y.):=random(16);
textcolor(von(.x,y.));
write(l)
END;
END;
PROCEDURE editor (VAR von:raum);
var
ch1,ch2 : char;
xz,yz,z:integer;
begin
z :=0;
x := xa;
y:=ya;
randomize;
text_anfang;
gotoxy(1,1);
textcolor(0);
FOR yz := 1 TO 24
DO
FOR xz := 1 TO 80
DO
BEGIN
von(.xz,yz.) := 0;
write(l);
END;
repeat
textcolor(cursor);
ch1 := readkey;
IF ch1 =#0
THEN
BEGIN
ch2 := readkey;
CASE ch2 OF
#68 : BEGIN
zufall(von);
END;
#72 : y :=y^.v;
#80 : y :=y^.n;
#75 : x :=x^.v;
#77 : x :=x^.n;
#71 : BEGIN
y := y^.v;
x := x^.v;
END;
#73 : BEGIN
y := y^.v;
x := x^.n;
END;
#81 : BEGIN
y := y^.n;
x := x^.n;
END;
#79 : BEGIN
y := y^.n;
x := x^.v;
END;
#82 : IF z < 15 THEN z :=z +1 ELSE write(char(7));
#83 : IF z > 0 THEN z :=z -1 ELSE write(char(7));
ELSE
write(char(7))
END;
gotoxy(x^.i,y^.i);
von(.x^.i,y^.i.) := z;
textcolor(z);
write(l);
textcolor(cursor);
gotoxy(x^.i,y^.i);
END
ELSE write(char(7));
until ch1 = #13;
text_ende;
END;
PROCEDURE korrektor (VAR von:raum);
var
ch1,ch2 : char;
xz,yz,z:integer;
begin;
randomize;
x:=xa;y:=ya;
text_anfang;
gotoxy(1,1);
z := 0;
FOR yz := 1 TO 24
DO
FOR xz := 1 TO 80
DO
BEGIN
textcolor(von(.xz,yz.));
write(l);
END;
repeat
textcolor(cursor);
ch1 := readkey;
IF ch1 =#0
THEN
BEGIN
ch2 := readkey;
CASE ch2 OF
#68 : BEGIN
zufall(von);
END;
#72 : y :=y^.v;
#80 : y :=y^.n;
#75 : x :=x^.v;
#77 : x :=x^.n;
#71 : BEGIN
y := y^.v;
x := x^.v;
END;
#73 : BEGIN
y := y^.v;
x := x^.n;
END;
#81 : BEGIN
y := y^.n;
x := x^.n;
END;
#79 : BEGIN
y := y^.n;
x := x^.v;
END;
#82 : IF z < 15 THEN z :=z +1 ELSE write(char(7));
#83 : IF z > 0 THEN z :=z -1 ELSE write(char(7));
ELSE
write(char(7))
END;
gotoxy(x^.i,y^.i);
von(.x^.i,y^.i.) := z;
textcolor(z);
write(l);
textcolor(cursor);
gotoxy(x^.i,y^.i);
END
ELSE write(char(7));
until ch1 = #13;
text_ende;
END;
PROCEDURE spiel(VAR von,nach :raum);
BEGIN
y :=ya;
x :=xa;
REPEAT
REPEAT
nach(.x^.i,y^.i.):=neu(von,x,y);
textcolor(nach(.x^.i,y^.i.));
write(l);
x := x^.n
UNTIL x =xa;
y := y^.n
UNTIL y =ya;
END;
PROCEDURE hauptprogramm;
var
ch1,ch2 : char;
xz,yz:integer;
begin
IF keypressed THEN REPEAT ch1 := readkey UNTIL not(keypressed);
repeat
IF keypressed
THEN
BEGIN
ch1 := readkey;
IF ch1 =#0
THEN
BEGIN
ch2 := readkey;
CASE ch2 OF
#59: BEGIN
x := xa;
abbaux(x);
y := ya;
abbauy(y);
aufbau;
editor(a);
END;
#60: korrektor(a);
ELSE
END;
END
ELSE;
END
ELSE
BEGIN
gotoxy(1,1);
spiel(a,b);
gotoxy(1,1);
spiel(b,a);
END
until ch1 = #13;
END;
(*------------------------------- Hauptprogramm -------------------*)
BEGIN
checkbreak := false;
aufbau;
editor(a);
hauptprogramm;
x := xa;
abbaux(x);
y := ya;
abbauy(y);
textbackground(black);
textcolor(white);
clrscr;
checkbreak := true;
END.
(**************************************** ENDE *******************)