home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Computer Club Elmshorn Atari PD
/
CCE_PD.iso
/
pc
/
0600
/
CCE_0641.ZIP
/
CCE_0641.PD
/
ADR_2.V13
/
ADRESSLE
/
ADRESSLE.GFA
(
.txt
)
< prev
next >
Wrap
GFA-BASIC Atari
|
1986-02-06
|
17KB
|
812 lines
ON BREAK CONT
version$="v2.0"
'
' --------------------------------------------
' globale Variablen:
'
' n.ame$ 25
' vorname$ 25
' strasse$ 25
' ort$ 25
' tel$ 15
' geb_tag$ 10
'
' titel$ enthält das »Titelbild«
'
' ptr% gesammte Anzahl von Adressen
' nr% aktuell angezeigte Adresse
' b.alert| Rückgabewert bei Alertboxen
' start% Anfang des Speicherbereichs
'
' aus! Endeflag
' ____________________________________________
'
init ! Allgemeine Vorbereitungen (z.B. Titel laden)
'
zeige_titel ! Startbilschirm anzeigen
zeige_seite(0) ! Seite anzeigen
laden ! Als erstes 'was laden
'
' **********************************************************************
' * *
' * 's Adressbüchle v2.0 *
' * *
' * 1988 by Joker Soft *
' * *
' * Johannes Schäfer, Am Rain 8, 7450 Hechingen *
' * *
' **********************************************************************
'
'
ON MENU KEY GOSUB taste ! Auf Tastendruck geht's ab nach "taste"
'
REPEAT ! ---- Hauptschleife ----
ON MENU ! Abfrage der Tastenbetätigung
IF MOUSEK ! Falls Mausklick ...
maus(MOUSEK) ! ... zu "maus", wo selbiger bearbeitet wird
ENDIF
UNTIL aus!=TRUE ! ---- Ende ----
'
VOID MFREE(start%) ! Hier finden die Aufräumerein statt
CLEAR
RESERVE
EDIT
'
' *********************************************************************
' * *
' * Prozeduren *
' * *
' *********************************************************************
'
'
'
PROCEDURE maus(k|) ! Mausbehandlung
PAUSE 3 ! nötig, weil sonst "Pfeif.."
LOCAL x&,y& ! Auslösende Koordinaten ...
x&=MENU(10) ! ... x von hier,
y&=MENU(11) ! ... y von da.
'
IF x&>550 AND x&<630 AND y&>350 AND y&<380 ! Falls rechts unten etc.
ende ! dann halt 'raus !
ELSE IF y&>310 AND y&<340
IF x&>40 AND x&<180
laden
ELSE IF x&>380 AND x&<520
speichern
ELSE IF x&>210 AND x&<280
IF k|=1
minus
ELSE
buchst_minus
ENDIF
ELSE IF x&>280 AND x&<350
IF k|=1
plus
ELSE
buchst_plus
ENDIF
ENDIF
ELSE IF x&>20 AND x&<540 AND y&>270 AND y&<300
IF k|=1
buchstabe(x&)
ELSE
nr%=0
anzeigen(nr%)
ENDIF
ELSE IF x&>95 AND x&<480 AND y&>385 AND y&<399
zeige_titel
ELSE
ausgeben(x&,y&)
ENDIF
RETURN
'
PROCEDURE taste
IF MENU(13)=4
contrl_taste
ELSE
norm_taste
ENDIF
REPEAT
UNTIL INKEY$=""
RETURN
'
PROCEDURE norm_taste
LOCAL tl&,th&
tl&=MENU(14) AND &HFF
th&=(MENU(14) AND &HFF00)/&H100
'
IF tl&=43 OR th&=&H4D ! + ⇨
plus
ENDIF
IF tl&=45 OR th&=&H4B ! - ⇦
minus
ENDIF
IF th&=&H48 ! ⇧
buchst_plus
ENDIF
IF th&=&H50 ! ⇩
buchst_minus
ENDIF
IF th&=&H52 ! INSERT
eingeben
ENDIF
IF th&=&H47 ! HOME
nr%=0
anzeigen(nr%)
ENDIF
IF th&=&H61 ! UNDO
aendern
ENDIF
IF tl&>96 AND tl&<123 ! Kleinbuchstaben zu großen
SUB tl&,32
ENDIF
IF tl&>64 AND tl&<91 ! Großbuchstaben behandeln
IF abc%(tl&-65)<>-1
nr%=abc%(tl&-65)
anzeigen(nr%)
ENDIF
ENDIF
IF th&=&H1 ! ESC
zeige_titel
ENDIF
RETURN
'
PROCEDURE contrl_taste
LOCAL tl&,th&
tl&=MENU(14) AND &HFF
th&=(MENU(14) AND &HFF00)/&H100
'
IF th&=&H12 OR th&=&H31 ! E oder N
eingeben
ENDIF
IF th&=&H28 ! Ä
aendern
ENDIF
IF th&=&H1F ! S
speichern
ENDIF
IF th&=&H26 ! L
laden
ENDIF
IF th&=&H21 ! F
suchen
ENDIF
IF th&=&H2D ! X
ende
ENDIF
IF th&=&H53 ! DELETE
ALERT 3,"Willst Du die Adresse|tatsächlich löschen ?",1,"JA|NEIN",b.alert|
IF b.alert|=1
loesche_inhalt
anzeigen(nr%)
ENDIF
ENDIF
IF th&=&H20 ! D
ausgeben(300,180)
ENDIF
RETURN
'
'
PROCEDURE suchen
LOCAL i%,ziel$
DEFMOUSE 3
IF ptr%>0
clr_seite
PRINT AT(15,6);"Suchstring: ";
FORM INPUT 25 AS such$
IF such$<>""
FOR i%=0 TO ptr%-1
ziel$=SPACE$(125)
BMOVE start%+i%*125,VARPTR(ziel$),125
IF INSTR(ziel$,such$)>0
nr%=i%
anzeigen(nr%)
REPEAT
UNTIL INKEY$<>"" OR MOUSEK
ENDIF
EXIT IF BIOS(11,-1)=4
NEXT i%
ENDIF
anzeigen(nr%)
ENDIF
DEFMOUSE 0
RETURN
'
PROCEDURE buchst_plus
LOCAL i%,z&
IF nr%<ptr%-1
FOR i%=nr%+1 TO ptr%-1
z&=PEEK(start%+125*i%)-65
EXIT IF abc%(z&)<>-1 AND z&+65<>ASC(n.ame$)
NEXT i%
IF i%=ptr%
DEC i%
ENDIF
nr%=i%
anzeigen(nr%)
ENDIF
RETURN
'
PROCEDURE buchst_minus
LOCAL i%,z&
IF nr%>0
FOR i%=nr%-1 DOWNTO 0
z&=PEEK(start%+125*i%)-65
EXIT IF abc%(z&)<>-1 AND z&+65<>ASC(n.ame$)
NEXT i%
IF i%=-1
INC i%
ENDIF
nr%=i%
anzeigen(nr%)
ENDIF
RETURN
'
PROCEDURE ende
ALERT 2,"Wirklich Ende ??",1,"JA|Nein",b.alert|
IF b.alert|=1
aus!=TRUE
ENDIF
RETURN
'
PROCEDURE speichern
LOCAL datei$
IF ptr%>0
datei$=@select$("Speichern","\*._le")
IF datei$<>""
BSAVE datei$,start%,ptr%*125
ENDIF
ENDIF
RETURN
'
PROCEDURE laden
LOCAL datei$
datei$=@select$("Laden","\*._le")
IF datei$<>"" AND EXIST(datei$)
BLOAD datei$,start%
OPEN "i",#1,datei$
ptr%=LOF(#1)/125
CLOSE
anzeigen(nr%)
init_abc
ENDIF
RETURN
'
PROCEDURE zeige_titel
GET 20,20,550,310,save$
PUT 20,20,titel$
PRINT AT(10,10);version$
DEFTEXT 1,16,0,6
TEXT 140,60,"geschrieben in GfA-BASIC v3.0"
REPEAT
UNTIL MOUSEK OR INKEY$<>""
PUT 20,20,save$
RETURN
'
PROCEDURE plus
IF nr%<ptr%-1
INC nr%
anzeigen(nr%)
ENDIF
RETURN
'
PROCEDURE minus
IF nr%>0
DEC nr%
anzeigen(nr%)
ENDIF
RETURN
'
PROCEDURE eingeben
loesche
eingabe
IF n.ame$<>""
einfuegen
ENDIF
anzeigen(nr%)
RETURN
'
PROCEDURE aendern
IF ptr%>0
hole_inhalt(nr%)
eingabe
loesche_inhalt
einfuegen
anzeigen(nr%)
init_abc
ENDIF
RETURN
'
PROCEDURE buchstabe(x&)
DIV x&,20
DEC x&
IF abc%(x&)<>-1 AND abc%(x&)>nr%
nr%=abc%(x&)
anzeigen(abc%(x&))
ENDIF
RETURN
'
PROCEDURE ausgeben(x&,y&)
IF k|=2
SELECT @flip(x&,y&,men_ausgeben$())
CASE 1
aus_1x(nr%,"LST:")
CASE 2
datei$=@select$("> Datei","\*.TXT")
aus_1x(nr%,datei$)
CASE 3
aus_kompl("LST:")
CASE 4
datei$=@select$("alles > Datei","\*.TXT")
aus_kompl(datei$)
ENDSELECT
ELSE
SELECT @flip(x&,y&,men_eintrag$())
CASE 1
plus
CASE 2
minus
CASE 3
eingeben
CASE 4
aendern
CASE 5
ALERT 3,"Willst Du die Adresse|tatsächlich löschen ?",1,"JA|NEIN",b.alert|
IF b.alert|=1
loesche_inhalt
anzeigen(nr%)
ENDIF
CASE 6
suchen
ENDSELECT
ENDIF
RETURN
'
PROCEDURE loesche_inhalt
IF ptr%>0
IF nr%<ptr%-1
BMOVE start%+nr%*125+125,start%+nr%*125,ptr%*125-125-nr%*125
ENDIF
DEC ptr%
IF nr%=ptr%
DEC nr%
ENDIF
init_abc
ENDIF
RETURN
'
'
PROCEDURE aus_1x(nr%,nach$)
DEFMOUSE 2
IF ptr%>0
IF (OUT?(0) AND nach$="LST:") OR (nach$<>"" AND nach$<>"LST:")
IF EXIST(nach$) AND nach$<>"LST:"
OPEN "u",#1,nach$
ELSE
OPEN "o",#1,nach$
ENDIF
s$="Soll die Telefonnr. und|das Geburtsdatum|mitgedruckt werden ?"
ALERT 2,s$,1,"Nein|Nur Tel.|Beides",b.alert|
hole_inhalt(nr%)
PRINT #1,n.ame$;", ";vorname$
PRINT #1,strasse$
IF nach$="LST:"
PRINT #1,CHR$(27);CHR$(&H2D);CHR$(1);
ENDIF
PRINT #1,ort$
IF nach$="LST:"
PRINT #1,CHR$(27);CHR$(&H2D);CHR$(0);
ENDIF
IF b.alert|<>1
PRINT #1,tel$
IF b.alert|=3
PRINT #1,geb_tag$
ENDIF
ENDIF
PRINT #1
CLOSE
ELSE
IF nach$<>""
ALERT 3," Erst Drucker anschalten !",1,"Ach so !",b.alert|
ENDIF
ENDIF
ENDIF
DEFMOUSE 0
RETURN
'
PROCEDURE aus_kompl(nach$)
LOCAL i%,l&,ll&
DEFMOUSE 2
IF ptr%>0
IF (OUT?(0) AND nach$="LST:") OR (nach$<>"" AND nach$<>"LST:")
OPEN "o",#1,nach$
FOR i%=0 TO ptr%-1
hole_inhalt(i%)
l&=LEN(n.ame$)+LEN(vorname$)+1
IF l&>ll&
ll&=l&
ENDIF
NEXT i%
ADD ll&,2
FOR i%=0 TO ptr%-1
hole_inhalt(i%)
voller_name$=SPACE$(ll&)
LSET voller_name$=n.ame$+" "+vorname$+", "
PRINT #1,voller_name$;strasse$;","
PRINT #1,SPC(LEN(voller_name$));ort$;", ";tel$;", ";geb_tag$
NEXT i%
CLOSE
ELSE
IF nach$<>""
ALERT 3," Erst Drucker anschalten !",1,"Ach so !",b.alert|
ENDIF
ENDIF
ENDIF
DEFMOUSE 0
RETURN
'
PROCEDURE anzeigen(nr%)
clr_seite
'
IF ptr%>0
hole_inhalt(nr%)
zeige_seite(ASC(UPPER$(LEFT$(n.ame$)))-65)
PRINT AT(14,5);n.ame$;","'vorname$
PRINT AT(15,7);strasse$
PRINT AT(15,9);ort$
PRINT AT(15,10);STRING$(LEN(ort$),255)
PRINT AT(15,12);tel$
PRINT AT(55,16);SPACE$(10)
PRINT AT(15,14);geb_tag$
PRINT AT(55,16);"Seite"'nr%+1
ENDIF
RETURN
'
PROCEDURE schreibe_inhalt(nr%,inh$)
IF inh$<>SPACE$(125)
BMOVE VARPTR(inh$),start%+125*nr%,125
init_abc
ENDIF
RETURN
'
DEFFN erweitern$(s$,l&)=s$+SPACE$(l&-LEN(s$))
'
PROCEDURE clr_seite
DEFFILL 0
PBOX 100,50,535,265
RETURN
'
PROCEDURE eingabe
zeige_seite(0)
clr_seite
BOX 100,64,500,240
BOX 102,66,498,238
WHILE INKEY$<>""
WEND
REPEAT
PRINT AT(23,6);"Name : ";
FORM INPUT 25 AS n.ame$
zeige_seite(ASC(UPPER$(LEFT$(n.ame$)))-65)
PRINT AT(20,7);"Vorname : ";
FORM INPUT 25 AS vorname$
PRINT AT(21,9);"Straße : ";
FORM INPUT 25 AS strasse$
PRINT AT(15,10);"Plz. und Ort : ";
FORM INPUT 25 AS ort$
PRINT AT(20,12);"Telefon : ";
FORM INPUT 15 AS tel$
PRINT AT(17,14);"Geburtstag : ";
FORM INPUT 10 AS geb_tag$
UNTIL BIOS(11,-1)<>4
clr_seite
RETURN
'
PROCEDURE einfuegen
LOCAL i%,vergl$,inhalt$
i%=0
IF ptr%>0
'
FOR i%=0 TO ptr%-1 ! Suchen
vergl$=SPACE$(25) ! evt. durch andere Such-
BMOVE start%+i%*125,VARPTR(vergl$),25 ! methode zu ersetzen.
EXIT IF UPPER$(n.ame$)<UPPER$(vergl$)
NEXT i%
'
IF i%<ptr%
BMOVE start%+125*i%,start%+125*i%+125,125*(ptr%-i%)
ENDIF
ENDIF
packe(inhalt$)
IF inhalt$<>SPACE$(125)
schreibe_inhalt(i%,inhalt$)
INC ptr%
init_abc
ENDIF
RETURN
'
PROCEDURE loesche
CLR n.ame$,vorname$,strasse$,ort$,tel$,geb_tag$
RETURN
'
PROCEDURE hole_inhalt(nr%)
LOCAL ziel$
IF ptr%>0
ziel$=SPACE$(125)
BMOVE start%+nr%*125,VARPTR(ziel$),125
'
n.ame$=TRIM$(LEFT$(ziel$,25))
vorname$=TRIM$(MID$(ziel$,26,25))
strasse$=TRIM$(MID$(ziel$,51,25))
ort$=TRIM$(MID$(ziel$,76,25))
tel$=TRIM$(MID$(ziel$,101,15))
geb_tag$=TRIM$(MID$(ziel$,116,10))
ENDIF
RETURN
'
PROCEDURE zeige_seite(nr%)
LOCAL i%
DEFTEXT 1,0,0,13
DEFFILL 0
PBOX 23,270,539,299
'
IF nr%=77
nr%=0
ENDIF
IF nr%=88
nr%=14
ENDIF
IF nr%=89
nr%=20
ENDIF
IF nr%>=0 AND nr%<26
TEXT nr%*20+27,290,CHR$(nr%+65)
IF nr%<25
FOR i%=nr%+1 TO 25
TEXT i%*20+27,290,CHR$(i%+65)
BOX i%*20+20,270,i%*20+40,300
NEXT i%
BOX (nr%+1)*20+21,271,(i%-1)*20+40,300
ENDIF
TEXT 62,85,CHR$(nr%+65)
ENDIF
RETURN
'
PROCEDURE packe(VAR ziel$)
ziel$=@erweitern$(n.ame$,25)
ziel$=ziel$+@erweitern$(vorname$,25)
ziel$=ziel$+@erweitern$(strasse$,25)
ziel$=ziel$+@erweitern$(ort$,25)
ziel$=ziel$+@erweitern$(tel$,15)
ziel$=ziel$+@erweitern$(geb_tag$,10)
RETURN
'
PROCEDURE init_abc
LOCAL i%,z%
FOR i%=ptr%-1 DOWNTO 0
z%=PEEK(start%+125*i%)-65
IF z%>=0 AND z%<26
abc%(z%)=i%
ENDIF
NEXT i%
RETURN
'
FUNCTION flip(x&,y&,VAR men$())
LOCAL anzahl&,breite&,x_pos&,y_pos&,m_keys&,akt&,last&
anzahl&=DIM?(men$())-1
breite&=LEN(men$(0))
'
DIV x&,8
DIV y&,16
IF x&<2
x&=2
ENDIF
IF y&<3
y&=3
ENDIF
IF 79-x&<breite&
x&=79-breite&
ENDIF
IF 24-y&<anzahl&
y&=24-anzahl&
ENDIF
akt&=0
last&=0
x_min&=(x&+1)*8-16
x_max&=(x&+breite&+1)*8-16
y_min&=y&*16-1
y_max&=(y&+anzahl&)*16-1
GET x_min&-5,y_min&-5-16,x_max&+5,y_max&+5,screen$
rahmen(x&,y&-1,x&+breite&,y&+anzahl&)
fuellen
REPEAT
MOUSE x_pos&,y_pos&,m_keys&
last&=akt&
IF x_pos&>=x_min& AND x_pos&<=x_max& AND y_pos&>=y_min& AND y_pos&<=y_max&
akt&=(y_pos&-2-y_min&) DIV 16+1
ELSE
akt&=0
ENDIF
IF last&<>akt&
update
ENDIF
UNTIL m_keys&=0
PUT x_min&-5,y_min&-5-16,screen$
RETURN akt&
ENDFUNC
'
PROCEDURE fuellen
LOCAL i&
HIDEM
FOR i&=1 TO anzahl&
PRINT AT(x&,y&+i&);men$(i&);
NEXT i&
SHOWM
RETURN
'
PROCEDURE update
HIDEM
IF last&<>0
PRINT AT(x&,y&+last&);men$(last&)
ENDIF
IF akt&<>0
PRINT AT(x&,y&+akt&);CHR$(27);"p";men$(akt&);CHR$(27);"q";
ENDIF
SHOWM
RETURN
'
PROCEDURE rahmen(x0&,y0&,x1&,y1&)
HIDEM
ADD x1&,2
DEC x0&
x0&=SHL(x0&,3)
SUB x0&,5
DEC x1&
x1&=SHL(x1&,3)
SUB x1&,12
DEC y0&
y0&=SHL(y0&,4)
ADD y0&,11
DEC y1&
y1&=SHL(y1&,4)
ADD y1&,20
DEFFILL 0
PBOX x0&,y0&,x1&,y1&
BOX x0&,y0&,x1&,y1&
BOX x0&+2,y0&+2,x1&-2,y1&-2
BOX x0&+3,y0&+3,x1&-3,y1&-3
DEFTEXT 1,0,0,6
TEXT x0&+4,y0&+17,men$(0)
RETURN
'
FUNCTION select$(txt$,pfad$)
LOCAL save$,s$
GET 150,15,485,55,save$
DEFFILL 0
PBOX 157,20,482,54
BOX 157,20,482,54
BOX 160,23,479,51
BOX 161,24,478,50
DEFTEXT 1,5,0,13
TEXT 250,44,150,txt$
FILESELECT pfad$,"",s$
PUT 150,15,save$
IF LEN(s$)<4
s$=""
ENDIF
RETURN s$
ENDFUNC
'
' ******************** Initialisierungsprozeduren ***************************
'
PROCEDURE init
LOCAL vorn#,hinten#,s_tel$,i|
'
RESERVE 100000 ! Basic-Speicher verkleinern
start%=MALLOC(100000) ! und sonstigen Speicher vom Gemdos holen
'
titel$=SPACE$(18684) ! Platz für's Titelbild
BLOAD "\adressle\titel.obj",VARPTR(titel$) ! und laden ...
'
RESTORE s_tel ! Sprite-Daten
s_tel$=MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(1) ! für's Telefon
FOR i%=1 TO 16
READ vorn#,hinten#
LET s_tel$=s_tel$+MKI$(hinten#)+MKI$(vorn#)
NEXT i%
'
DIM men_ausgeben$(4) ! Pop-Up-Menü einlesen, damit wir's parat haben
RESTORE ausgeben ! (über die linke Maustaste erreichbar)
FOR i|=0 TO 4
READ men_ausgeben$(i|)
NEXT i|
'
DIM men_eintrag$(6) ! ebenso das zweite, über die rechte Maustaste
RESTORE eintrag ! erreichbare Menü
FOR i|=0 TO 6
READ men_eintrag$(i|)
NEXT i|
'
DIM abc%(25) ! das Array für die vorhandenen Buchstaben
ARRAYFILL abc%(),-1 ! zuerst mit -1 für nirgends "vorhanden" füllen
'
ptr%=0
nr%=0
'
zeige_schirm
RETURN
'
'
PROCEDURE zeige_schirm
LOCAL i&
DEFFILL 1,2,4
BOUNDARY 0
PBOX 0,0,640,400
'
DEFFILL 0
PBOX 20,20,540,300
BOX 20,20,540,300
BOX 23,23,537,267
DEFLINE ,3,,2
FOR i&=30 TO 540 STEP 25
ELLIPSE i&,25,8,15,200,2700
NEXT i&
DEFLINE ,1
'
BOX 40,64,90,94
LINE 40,64,90,94
LINE 40,94,90,64
SPRITE s_tel$,74,174
DEFTEXT 1,16
TEXT 78,222,"*"
'
DEFFILL 0
DEFTEXT 1,17,0,13
PBOX 210,310,350,340
BOX 210,310,350,340
BOX 211,311,349,339
BOX 211,311,280,339
TEXT 230,330,100,"- +"
'
DEFTEXT 1,5,0,13
PBOX 40,310,180,340
BOX 40,310,180,340
BOX 41,311,179,339
TEXT 70,330,70,"laden"
PBOX 380,310,520,340
BOX 380,310,520,340
BOX 381,311,519,339
TEXT 400,330,100,"speichern"
'
DEFTEXT 1,1,0,13
PBOX 550,350,630,380
BOX 550,350,630,380
BOX 551,351,629,379
BOX 553,353,627,377
TEXT 562,370,"E N D E"
'
DEFTEXT 1,0,0,6
PBOX 95,385,480,399
BOX 95,385,480,399
TEXT 100,395,"» 's Adressbüchle « 1988 by Johannes Schäfer"
RETURN
'
'
s_tel:
DATA 0,0,0,0,0,0,0,0,32766,0,32769,0,34785,0,35889,0
DATA 29742,0,1056,0,2448,0,4680,0,4680,0,4492,0,4106,0,4081,0
'
ausgeben:
DATA " AUSGEBEN "
DATA " > Drucker "
DATA " > Datei "
DATA " alles > Drucker "
DATA " alles > Datei "
eintrag:
DATA " EINTRAG "
DATA " vor "
DATA " zurück "
DATA " neu "
DATA " ändern "
DATA " löschen "
DATA " suchen "