Metropoli BBS
VIEWER: cncchat!.pps MODE: TEXT (CP437)
;                           -------------------------
;                            TYGER's CNC-CHAT! V1.0ß
;                           -------------------------
;
;                            (C)1995 TYGER/PAiN!-CNC
;
;
; Do not modify and re-distribute!
;

string u,ss,s,rr,is(25),iu(25),qs(25),dl,scl,ucl,ti,da
integer r,mx,i,o,sx,sy,sxl,syl,ux,uy,uxl,uyl,csx,csy,cux,cuy,cu,cs
boolean sys,ex

ansipos 1,23
savescrn
if (exist(ppepath()+"cncchat."+i2s(pcbnode(),10))) then
fappend 2,ppepath()+"cncchat."+i2s(pcbnode(),10),o_wr,s_dn
else
fopen 2,ppepath()+"cncchat."+i2s(pcbnode(),10),o_wr,s_dn
endif
ti=time()
getuser
fputln 2
fputln 2,"USER       : "+u_name()
fputln 2,"L0CATi0N   : "+u_city()
fputln 2
let da=date()
fputln 2,"DATE       : "+da
fputln 2,"STARTED AT : "+ti
fputln 2,"──────────────────────────────────────────────────────────────────────────────"

let mx=s2i(left(readline(ppepath()+"cncchat!.cfg",1),1),10)
let ss=upper(left(readline(ppepath()+"cncchat!.cfg",2),1))
let ex=(upper(left(readline(ppepath()+"cncchat!.cfg",3),1))="Y")
let dl="                                                                                "
if (ss="Y") then
let rr=i2s(random(mx-1)+1,10)
endif
if (ss<>"Y") let rr=ss
:res
print "@CLS@@POFF@"
dispfile ppepath()+"cncchat"+rr+".pcb",graph
ansipos 1,1
fopen 1,ppepath()+"cncchat"+rr+".cfg",o_rd,s_dn
fget 1,sx
fget 1,sy
fget 1,sxl
fget 1,syl
fget 1,ux
fget 1,uy
fget 1,uxl
fget 1,uyl
fget 1,scl
fget 1,ucl
fclose 1
for i=1 to 23
let iu(i)=""
let is(i)=""
next
let csx=sx
let csy=sy
let cux=ux
let cuy=uy
let cs=1
let cu=1

goto lo1

:lo3
sys=true
if (len(is(cs))<sxl-sx) then
let is(cs)=is(cs)+s
ansipos csx,csy
print scl+s
inc csx
else
fputln 2,"S : "+is(cs)
inc cs
inc csy
if (csy>syl) then
for i=1 to cs-1
let is(i)=is(i+1)
ansipos sx,sy+i-1
print is(i+1)+left(dl,sxl-sx-len(is(i)))
next
csy=syl
dec cs
endif
let csx=sx
endif
goto lo1

:lo4
sys=false
if (len(iu(cu))<uxl-ux) then
let iu(cu)=iu(cu)+u
ansipos cux,cuy
print ucl+u
inc cux
else
fputln 2,"U : "+iu(cu)
inc cu
inc cuy
if (cuy>uyl) then
for i=1 to cu-1
let iu(i)=iu(i+1)
ansipos ux,uy+i-1
print iu(i+1)+left(dl,uxl-ux-len(iu(i)))
next
cuy=uyl
dec cu
endif
let cux=ux
endif
goto lo1


:lo1
if (sys) ansipos csx,csy
if (!sys) ansipos cux,cuy
:lo2
let s=kinkey()
let u=minkey()
if ((s="")&(u="")) goto lo2
if ((s=chr(27))|((u=chr(27))&(ex))) goto en

if (s=chr(9)) then
fputln 2,"** SYS0P CHANGED PiCTURE"
color @X20
ansipos 10,5
sprint "                     "
ansipos 10,6
sprint " USE WHiCH PiCTURE ? "
ansipos 10,7
sprint "                     "
ansipos 10,8
sprint "                     "
ansipos 10,9
sprint "                     "
color @X01
for i=6 to 9
ansipos 9,i
sprint "▐"
next
ansipos 10,10
sprint "▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀"
let r=s2i(rr,10)
:li4
ansipos 16,8
color @X2F
sprint "[ "+i2s(r,10)+" / "+i2s(mx,10)+" ]"
ansipos cux,cuy
:li3
let s=kinkey()
if (s="") goto li3
if (s="UP") then
inc r
if (r>mx) let r=1
goto li4
endif
if (s="DOWN") then
dec r
if (r<1) let r=mx
goto li4
endif
if (s<>chr(13)) goto li3
let rr=i2s(r,10)
color @X01
goto res
endif

if (s=chr(8)) then
if (len(is(cs))>0) then
let is(cs)=left(is(cs),len(is(cs))-1)
dec csx
ansipos csx,csy
print "  "
goto lo1
else goto lo1
endif
endif

if (u=chr(8)) then
if (len(iu(cu))>0) then
let iu(cu)=left(iu(cu),len(iu(cu))-1)
dec cux
ansipos cux,cuy
print "  "
goto lo1
else goto lo1
endif
endif

if (s=chr(13)) then
fputln 2,"S : "+is(cs)
inc cs
inc csy
if (csy>syl) then
for i=1 to cs-1
let is(i)=is(i+1)
ansipos sx,sy+i-1
print is(i+1)+left(dl,sxl-sx-len(is(i)))
next
csy=syl
dec cs
endif
let csx=sx
goto lo1
endif

if (u=chr(13)) then
fputln 2,"U :"+iu(cu)
inc cu
inc cuy
if (cuy>uyl) then
for i=1 to cu-1
let iu(i)=iu(i+1)
ansipos ux,uy+i-1
print iu(i+1)+left(dl,uxl-ux-len(iu(i)))
next
cuy=uyl
dec cu
endif
let cux=ux
goto lo1
endif

if ((s>=" ")&(len(s)=1)) goto lo3
if ((u>=" ")&(len(u)=1)) goto lo4
goto lo2

:en
ti=time()
fputln 2,"──────────────────────────────────────────────────────────────────────────────"
fputln 2,"** CHAT ENDED AT "+ti
fputln 2,"══════════════════════════════════════════════════════════════════════════════"
fclose 2
color @X01
cls
print "@X01 [ V1.0ß (C)TYGER/PAiN!-CNC ]"
delay 20
restscrn
end
[ RETURN TO DIRECTORY ]