Code archives/File Utilities/Text Editor (b+)
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Blitz plus text editor. | |||||
; ; ; ; ; Type bluekeywords Field shortkw$ Field longkw$ End Type Global ww = 800 Global wh = 600 ; active line colors Global bluevisualsactive = True Global blueactiveliner = 20 Global blueactivelineg = 100 Global blueactivelineb = 180 Global blueactivelinefr = 240 Global blueactivelinefg = 240 Global blueactivelinefb = 240 Global blueactivelinesr = 190 Global blueactivelinesg = 130 Global blueactivelinesb = 90 ; txt area background color Global bluebackcolorr = 0 Global bluebackcolorg = 76 Global bluebackcolorb = 150 ; txt area main color Global bluetextcolorr = 240 Global bluetextcolorg = 240 Global bluetextcolorb = 240 ; line numbering colors Global bluelinenumberbr = 0 ; line numbering background colors Global bluelinenumberbg =60 Global bluelinenumberbb = 120 ; line numbers Global bluelinenumbertr = 180 Global bluelinenumbertg = 180 Global bluelinenumbertb = 180 ;Global editor interactive controllers Global bluepagedownscroll Global bluepageupscroll Global bluectrlpagedownscroll Global bluectrlpageupscroll Global linecounter = 0 Const bluedefaulttabsize = 4 Global blueinsertmode = False Global bluelinenumberwidth = 32 Global bluelinenumbervisible = True ; Line numbers Disable Enable Global bluelinenumberimagebuffer = CreateImage(bluelinenumberwidth,wh) Global bluelinenumberupdate = True ; false means do not redraw the line number bar Global bluecursorcolorr = 255 Global bluecursorcolorg = 255 Global bluecursorcolorb = 255 Global blueinsertcursorcolorr = 255 Global blueinsertcursorcolorg = 255 Global blueinsertcursorcolorb = 255 Global bluelinecopybuffer$ ="" ;line edit return commands Const bluecloseapp = -99 Const bluepageup = -100 Const bluepagedown = -101 Const bluectrlend = -102 Const bluectrlhome = -103 Global bluenumlines = 140 ; max num of lines Const bluepointers = 64 Dim blue$(bluenumlines,bluepointers) Const blueactive = 0 Const bluec = 1 Const bluecursortimer = 2 Const bluecursortimerdelay = 3 Const blueshowcursor = 4 Const bluecursorpos = 5 Const blueselstart = 6 Const blueselend = 7 Const blueselactive = 8 Const blueinvselstart = 9 Const blueinvselactive = 10 Const blueshiftactive = 11 Const bluectrlactive = 12 Const bluecopybuffer = 13 Const bluec_back = 14 Const bluec_front = 15 Const bluehastab = 16 Const bluehascolor = 17 Const bluehasunderline = 18 Const bluehasbold = 19 Const bluehasitalic = 20 Const bluehasicon = 21 Const bluehasmultiplefonts = 22 Const bluetabmodifier = 23 Const blueabsfontheight = 24 ;Cursor mouse interaction Global bluecursorx = 0a Global bluecursory = 0 Global bluecursorupdate = False ;buffering Global bluelinenumimagebuffer = CreateImage(bluelinenumberwidth,32) bufferlinenumbers ; make one image buffer ; Ask for mode ;If FileType("back.bmp") <> 1 Then RuntimeError "cannot find back.bmp" ;Global backimage = LoadImage("back.bmp") Global backimage = CreateImage(320,200) MaskImage backimage,0,0,0 Const blue_tab = 9 Global mx Global my Global bluelinewidth = 72 ; Blue Core gadgets Global lineareawin Global lineareacan Global backcan root$ = CurrentDir() file$ = root$ + "welcome.txt" ;If FileType(file$) = 1 Then blueloadtext(root$+"welcome.txt") If FileType(file$) = 1 Then blueloadtext(root$+"keywords.txt") If FileType(CommandLine()) = 1 Then blueloadtext(CommandLine()) ;loadkeywords blue_ed(ww,wh,Desktop()) End Function blue_ed(w,h,parent) ; main edit loop cx = GadgetWidth(parent)/2-w/2 cy = GadgetHeight(parent)/2-h/2 Local win = CreateWindow("Blue - Beta version march2004 - Crom Design",cx,cy,w,h,parent,1) Local can = CreateCanvas(0,0,w,h,win) lineareawin = CreateWindow("",0,0,w,32,win,32) backcan = CreateCanvas(0,0,w,32,lineareawin) : SetBuffer CanvasBuffer(backcan) : ClsColor blueactiveliner,blueactivelineg,blueactivelineb:Cls Local canvasoffsety = ClientHeight(can)-ClientHeight(win)-2 ; Fix for XP and Standard Windows interface ;RuntimeError canvasoffsety Local we ;event Local prevline = 0 ; make global Local scrolldown = False Local scrollup = False Local cursorontop = False Local cursoronbottom = False SetBuffer CanvasBuffer(can) ClsColor bluebackcolorr,bluebackcolorg,bluebackcolorb:Cls tm = CreateTimer(30) SetBuffer CanvasBuffer(can) Cls Color 240,240,240 DrawImage backimage,GadgetWidth(can)/2-ImageWidth(backimage)/2,0 drawblue(can,linecounter) FlipCanvas(can) ma = 0 fh = FontHeight() While we<>$803 we = WaitEvent() Select we Case $101 ;- Key down Case $102 ;- Key up If EventData() = 1 Then Exit Case $103 ;- Key stroke Case $201 ;- Mouse down Case $202 ;- Mouse up ;ma = (EventY()/fh)+linecounter Case $203 ;- Mouse move mx = EventX():my = EventY() Case $204 ;- Mouse wheel Case $205 ;- Mouse enter Case $206 ;- Mouse leave Case $401 ;- Gadget action Case $801 ;- Window move ;SetGadgetShape win,GadgetX(parent)+20,GadgetY(parent+22),GadgetWidth(win),GadgetHeight(win) Case $802 ;- Window size Case $803 ;- Window close Case $804 ;- Window activate Case $1001 ;- Menu event Case $2001 ;- App suspend Case $2002 ;- App resume Case $2003 ;- App Display Change Case $2004 ;- App Begin Modal Case $2005 ;- App End Modal Case $4001 ;- Timer tick ; Editor active If ma > -1 Then prevline = ma DebugLog (ma-linecounter)*fh ma = blueline(win,blue(ma,bluec),ma,(ma-linecounter)*fh+canvasoffsety) SetBuffer CanvasBuffer(can) ;SetGadgetText win,"Maxlines : " + bluenumlines + " ma : " + ma + " prevline : " + prevline + " linecounter : " + linecounter ; Line feedback handler Select ma ; trap/translate global commands Case bluecloseapp End Case bluepageup st = prevline - linecounter tp = bluemaxvislines(can)-1 If prevline - tp > 0 Then If st = tp Then ; bottom up ma = linecounter Else ; top up If linecounter - tp-1 > 0 Then linecounter = linecounter - (tp-1) If st = 0 Then ; if on top of page ma = linecounter-1 Else ; if in the middle ma = linecounter End If End If End If Else ; if near top then set to top ma = 0 : linecounter = 0 End If Case bluepagedown ; ma = linecounter sval = 10;bluectrlpagedownscroll st = prevline - linecounter tp = bluemaxvislines(can)-1 If prevline + tp < bluenumlines-tp Then If st = tp Then ; bottom down If bluecontrolispressed() Then ; if control ma = prevline + sval + 1 linecounter = linecounter + sval+1 Else ma = prevline + tp + 1 linecounter = prevline - 1 EndIf Else ; top down If linecounter + tp-1 < bluenumlines Then If st = 0 Then ; if on bottom of page If bluecontrolispressed() Then ; if control ma = prevline + sval Else ma = tp + st If linecounter > 0 Then linecounter = linecounter + st : ma = linecounter + tp End If Else ; if in the middle If bluecontrolispressed() Then ; if control is pressed ;linecounter = prevline ma = prevline + sval;tp Else ; if not linecounter = prevline ma = prevline + tp End If End If End If End If Else ; if near bottom then set bottom to top ma = bluenumlines : linecounter = bluenumlines-tp End If Case bluectrlhome ma = 0 linecounter = 0 bluelinenumberupdate = True Case bluectrlend ma = bluenumlines linecounter = bluenumlines+1 - bluemaxvislines(can) ;DebugLog ma ;DebugLog linecounter bluelinenumberupdate = True End Select ; Bounding If ma>bluenumlines Then ma = bluenumlines ; Text single line scrolling If ma>-1 Then If ma-linecounter => bluemaxvislines(can) And ma>prevline And ma< bluenumlines+1 Then ; down cursoronbottom = True ma = bluemaxvislines(can) + linecounter linecounter = linecounter + 1 scrolldown= True : scrollup = False End If If ma < prevline And linecounter > 0 And cursorontop = True Then ; up linecounter = linecounter - 1 If linecounter < 0 Then linecounter = 0 scrollup = True : scrolldown = False End If If scrolldown = True Then bluelinenumberupdate = True If scrollup = True Then bluelinenumberupdate = True If ma = -1 And scrolldown = True Then ma = bluenumlines : scrolldown = False If ma =< linecounter Then cursorontop = True Else cursorontop = False If ma-linecounter => bluemaxvislines(can) Then cursoronbottom = True Else cursoronbottom = False End If If ma = -1 Then ma = prevline SetBuffer CanvasBuffer(can) Cls ; Background image DrawImage backimage,GadgetWidth(can)/2-ImageWidth(backimage)/2,0 ; Draw the text drawblue(can,linecounter) FlipCanvas(can) End If End Select Wend End Function Function bluemaxvislines(can) ; return max vis lines on screen a = ((GadgetHeight(can)-13) / FontHeight()-3) If a > bluenumlines Then a = bluenumlines+1 Return a End Function Function linewidth(num) ; core l = Len(blue(num,bluec)) End Function Function drawblue(can,start) ; draw the text ; ms = MilliSecs() fh = FontHeight() ch = bluemaxvislines(can) cnt = start y = 0 ;set default color Color bluetextcolorr,bluetextcolorg,bluetextcolorb While y < ch If cnt=<bluenumlines bluedrawtext(x,y*fh,cnt,can) ; ; ; Rect x,y*fh,x+32,y+fh ; line numbering ; If blue(cnt,bluehastab) Then ; bluetexttab x,y*fh,blue(cnt,bluec) ; Else ; Text x,y*fh,blue(cnt,bluec) ; End If End If cnt=cnt+1 y=y+1 Wend If bluelinenumbervisible = True Then DrawBlock bluelinenumberimagebuffer,x,0 bluelinenumberupdate = False ;RuntimeError MilliSecs()-ms End Function Function bluedrawtext(x,y,num,can = 0, norules = False) Local hastab If norules = False Then If bluelinenumbervisible = True Then mod1 = blueLinenumberwidth End If If blue(num,bluehastab) = True Then hastab = True If can > 0 Then drawlinenumbering(x,y,num,can) End If If hastab = True Then bluetexttab x+mod1,y,blue(num,bluec) Else ; text gets drawn here drawtext(x+mod1,y,blue(num,bluec)) ;Text x+mod1,y,blue(num,bluec) End If End Function Function drawtext(x,y,t$) Local cof[856] Local cnt = 0 t$ = t$ + " " If Not Left(t$,1) = ";" Then For k.bluekeywords = Each bluekeywords ; a = Instr(Lower(t$),k\shortkw) If a cof[a] = True If a > 1 And Mid(t$,a-1,1) <> " " Then cof[a] = 0 If a+Len(k\shortkw) < Len(t$) If Mid(t$,a+Len(k\shortkw),1) <> " " Then cof[a] = 0 ;If Rand(5) = 1 Then DebugLog MilliSecs() End If cnt = cnt + 1 cof[ a + (Len(k\shortkw)) ] = -1 If a > 1 And Mid(t$,a-1,1) <> " " Then cof[a+Len(k\shortkw)] = 0 If a+Len(k\shortkw) < Len(t$) If Mid(t$,a+Len(k\shortkw),1) <> " " Then cof[a+Len(k\shortkw)] = 0 End If a = a + Len(k\shortkw) ; recurse the rest b = -1 : p = a+1 While b<>0 b = Instr(Lower(t$),k\shortkw,p) If b If Mid(t$,b-1,1) = " " And Mid(t$ , b + Len(k\shortkw), 1) = " " Then cof[b] = True cof[ b + (Len(k\shortkw)) ] = -1 End If p = b + 1 End If Wend b=-1 End If Next End If If cnt > 0 Then x1 = x For i=1 To Len(t$) If cof[i] = True Then Color 200,200,0 If cof[i] = -1 Then Color 255,255,250 nt$ = Mid(t$,i,1) Text x1,y,nt$ x1=x1+ StringWidth(nt$) Next Color 255,255,255 Else Text x,y,t$ End If End Function Function drawlinenumbering(x,y,num,can) If can = 0 Then Return If bluelinenumberupdate = False Then Return If bluelinenumbervisible = False Then Return SetBuffer ImageBuffer(bluelinenumberimagebuffer) ro = ColorRed() go = ColorGreen() bo = ColorBlue If Int(blue(num,blueabsfontheight)) = 0 Then fh = FontHeight() Else fh = blue(num,blueabsfontheight) Local tempthing = bluelinenumimagebuffer;CreateImage(bluelinenumberwidth,fh) ;SetBuffer ImageBuffer(bluelinenumberimagebuffer) ; Buffer this ; shaded color adjustement If bluevisualsactive = True Then ; DrawBlock tempthing,x,y+1 Else Color bluelinenumberbr,bluelinenumberbg,bluelinenumberbb Rect x,y+1,x+bluelinenumberwidth,y+fh+1,True ; line numbering End If ; Draw the line number Color bluelinenumbertr,bluelinenumbertg,bluelinenumbertb Text x-3,y,bluerightalign(num,4) Color ro,go,bo SetBuffer CanvasBuffer(can) End Function Function bluetexttab(x,y,a$) ;RuntimeError a$ For i=1 To Len(a$) cc$ = Mid(a$,i,1) Select Asc(cc) Case 9 For ii=1 To bluedefaulttabsize x = x + StringWidth("a") Next Default Text x,y,cc End Select fw = StringWidth(Mid(a$,i,1)) x=x+fw Next End Function Function bluelinenum(num) ; core ; Structural optimalization system goes here ; Return num ; return pointer to data End Function Function bluereadline$(num) ; return the line number num = bluelinenum(num) ; core Return blue(num,bluec) End Function Function bluewriteLine(num,in$) ; Write to the line number with in$ num = bluelinenum(num) ; core blue(num,bluec) = in$ End Function Function blueline(ms,def$="",num,offset_y);; ; edit single line - core num = bluelinenum(num) ; optimalization ;offset_y=offset_y+24 offset_y=offset_y;+GadgetY(ms) offset_x = 2 width_mod = 0 height_mod = 0 ; If bluelinenumbervisible = True Then offset_x = bluelinenumberwidth + 3 width_mod = bluelinenumberwidth + 3 End If ; Local wwidth = GadgetWidth(ms)-7 Local wheight = FontHeight() ;Local win = CreateWindow("",GadgetX(ms)+offset_x,GadgetY(ms)+offset_y,wwidth-width_mod,wheight,ms,32) Local win = lineareawin ;Local can = CreateCanvas(GadgetX(ms)+offset_x,GadgetY(ms)+offset_y,wwidth-width_mod,wheight,lineareawin) Local can = CreateCanvas(0,0,wwidth-width_mod,wheight,lineareawin) ;SetGadgetShape win,GadgetX(ms)+offset_x,GadgetY(ms)+offset_y,wwidth-width_mod,wheight SetGadgetShape win,GadgetX(ms)+offset_x,GadgetY(ms)+offset_y,wwidth-width_mod,wheight ; align text window to parent window!! SetGadgetShape can,0,0,wwidth-width_mod,wheight ;ActivateWindow win ;Local can = lineareacan ;SetGadgetShape can,0,0,wwidth,wheight SetBuffer CanvasBuffer(can) HideGadget backcan Local r = blueactiveliner Local g = blueactivelineg Local b = blueactivelineb Local fr = blueactivelinefr Local fg = blueactivelinefg Local fb = blueactivelinefb Local sr = blueactivelinesr Local sg = blueactivelinesg Local sb = blueactivelinesb ClsColor r,g,b:Cls FlipCanvas(can) ;RuntimeError "er" Local c$ = def$ Local cursortimer = MilliSecs()+1000 Local cursortimerdelay = 1000 Local showcursor = True ;oboe = Int(blue(num,bluecursorpos)) + ( bluelinenumberwidth / fontwidth() ) Local cursorpos = blue(num,bluecursorpos) cursorpos = bluemousecursorupdate() ;cursorpos = (bluecursorx - (bluelinenumberwidth/fontwidth())) Local selstart = blue(num,blueselstart) Local selend = blue(num,blueselend) Local selactive = blue(num,blueselactive) Local invselstart = blue(num,blueinvselstart) Local invselactive = False Local shiftactive = False Local ctrlactive = False Local altactive = False Local copybuffer$ = bluelinecopybuffer;blue(num,bluecopybuffer) c$ = def$ Local c_back$ = Right(c$,Len(c$)-cursorpos);blue(num,bluec_back) Local c_front$ = Left(c$,cursorpos);blue(num,bluec_front) Local MousX = 0 Local MousY = 0 Local exitline = -1 Local exitwithreturn = False Local exitwithcursup = False Local exitwithcursdown = False Local functionkeys[12] ; 1 --- 12 Local maxtextlen = (GadgetWidth(can)/StringWidth("a"))-1 ;RuntimeError c$ ;Local c_back$ = "" Local timer = CreateTimer(60) While we<>$803 we = WaitEvent() Select we Case $101 ;- Key down ; 54 r-shft, 42 - l-shft ; 157- rctrl, 29 - lctrl, 184-ralt,56-lalt ed = EventData() Select ed Case 54 ; rshift If selactive = False Then selactive = True : selstart = cursorpos : invselstart = cursorpos : sellen = 0 : shiftactive = True Case 42 ;lshift If selactive = False Then selactive = True : selstart = cursorpos : invselstart = cursorpos : sellen = 0: shiftactive = True Case 157 ; rctrl ctrlactive = True Case 29 ; lctrl ctrlactive = True Case 184 ; l alt altactive = True Case 56 ; r alt altactive = True End Select Case $102 ;- Key up ed = EventData() Select ed Case 54 : shiftactive = False Case 42 : shiftactive = False Case 29 : ctrlactive = False Case 184: ctrlactive = False End Select ;If EventData() = 1 Then Exit Case $103 ;- Key stroke (EDIT) ed = EventData():If ed = 13 Then we = $803 showcursor = True : cursortimer = MilliSecs() + cursortimerdelay ;backspa = 8 , 32 = space, 63273 ; homr ; ;63276 - pageup, 63277 pagedown ;RuntimeError ed Select ed Case 63276 ; Page up we = $803 exitline = bluepageup Case 63277 ; Page down we = $803 exitline = bluepagedown Case 9 ; Tab If shiftenabled = True Then End If If altenabled = True Then End If If ctrlenabled = True Then End If If shiftenabled = False And altenabled = False And ctrlenabled = False Then c_front = c_front + String(Chr(32),bluedefaulttabsize) cursorpos = cursorpos + bluedefaulttabsize ;store tab locations here End If Case 63271 ; Insert If blueinsertmode = True Then blueinsertmode = False Else blueinsertmode = True Case 63239 ; F4 If altactive = True Then we = $803 exitline = bluecloseapp End If Case 63272 ;del If selactive = False And shiftactive = False Then If Len(c_back$) > 0 c_back$ = Right(c_back$,Len(c_back$)-1) EndIf Else c_front$ = Left(c$,selstart) c_back$ = Right(c$,Len(c$)-selend) selactive = False : invselactive = False cursorpos = selstart If Len(c_back$) + Len(c_front$) = 0 Then cursorpos = 0 End If Case 63273 ; home If ctrlactive = False Then cursorpos = 0 c_front$ = Left(c$,cursorpos) c_back$ = Right(c$,Len(c$)-cursorpos) If shiftactive = False Then selactive = False Else ;Ctrl + home exitline = bluectrlhome we=$803 End If Case 63275 ; end If ctrlactive = False Then cursorpos = Len(c$) c_front$ = Left(c$,cursorpos) c_back$ = Right(c$,Len(c$)-cursorpos) If shiftactive = False Then selactive = False Else ;CTRL + End exitline = bluectrlend we=$803 End If Case 8 ; backspace ;If Len(c$) > 0 c$ = Left(c$,Len(c$)-2) c_front$ = Left(c_front$,Len(c_front$) - 1) If cursorpos > 0 Then cursorpos = cursorpos - 1 If shiftactive = False Then selactive = False Case 13 ; enter exitline = num + 1 exitwithreturn = True we = $803 Case 27 ; escape we = $803 Case 63232 ; curs up If num > 0 Then exitwithcursup = True exitline = num - 1 If cursorpos > Len(blue(exitline,bluec)) Then blue(exitline,bluecursorpos) = Len(blue(exitline,bluec)) Else blue(exitline,bluecursorpos) = cursorpos End If we = $803 End If Case 63233 ; curs down If num < bluenumlines Then exitwithcursdown = True exitline = num + 1 If cursorpos > Len(blue(num,bluec)) Then blue(exitline,bluecursorpos) = Len(blue(exitline,bluec)) Else blue(exitline,bluecursorpos) = cursorpos End If we = $803 Else we = $803 exitline = num End If Case 63235 ; cursright If ctrlactive = True Then If shiftactive = False Then selactive = False z = movecursorright(c$,cursorpos+1) ;DebugLog z If z =0 Then z=Len(c$) cursorpos = z c_front$ = Left(c$,cursorpos) c_back$ = Right(c$,Len(c$) - cursorpos) Else If cursorpos < Len(c$) Then cursorpos = cursorpos + 1 c_front$ = Left(c$,cursorpos) c_back$ = Right(c$,Len(c$)-cursorpos) If shiftactive = False Then selactive = False End If Case 63234 ; curs left If ctrlactive = True Then If shiftactive = False Then selactive = False z = movecursorleft(c$,cursorpos-1) If z <0 Then z=0 cursorpos = z c_front$ = Left(c$,cursorpos) c_back$ = Right(c$,Len(c$) - cursorpos) Else If cursorpos > 0 Then cursorpos = cursorpos - 1 c_front$ = Left(c$,cursorpos) c_back$ = Right(c$,Len(c$)-cursorpos) If shiftactive = False Then selactive = False End If Default ; all other keys If ctrlactive=False And altactive = False If blueinsertmode = False Then ; Regular type without Insert If cursorpos < maxtextlen And Len(c$) < maxtextlen c_front$ = c_front$ + Chr(ed) cursorpos = cursorpos + 1 selactive = False End If Else If cursorpos < maxtextlen ; Regular type with insert c_front$ = c_front$ + Chr(ed) c_back$ = Right(c_back$,Len(c_back$)-1) cursorpos = cursorpos + 1 selactive = False End If End If If shiftactive = False Then selactive = False End If End Select ; ;RuntimeError ; CTRL things If ctrlactive = True Then Select ed Case 22 ; Ctrl + v ; paste ; bluelinewidth If copybuffer$<> "" Then ; Single line copy paste!! If Len(copybuffer$) + Len(c$) < bluelinewidth Then If selactive = True Then c$ = c_front$ + c_back$ c$ = bluereplacelineselection(c$,copybuffer$,selstart,selend) cursorpos = (cursorpos - sellen) + Len(copybuffer$) c_front$ = Left(c$,cursorpos) c_back$ = Right(c$,Len(c$)-cursorpos) selactive = False Else c_front$ = c_front$ + copybuffer$ cursorpos = cursorpos + Len(copybuffer) End If End If End If Case 3 ; CTRL + C If selactive = True Then copybuffer$ = Mid(c$,selstart+1,sellen) DebugLog copybuffer$ End If Default End Select EndIf c$ = c_front$ + c_back$ Case $201 ;- Mouse down ; Position cursor bluecursorx = EventX() / FontWidth() If obluecursorx <> bluecursorx Then DebugLog bluecursorx cursorpos = bluecursorx c_front$ = Left(c$,cursorpos) c_back$ = Right(c$,Len(c$)-cursorpos) mup = False Case $202 ;- Mouse up mup = True nl = EventY() / FontHeight() + linecounter ;DebugLog "Exit val : " + nl + " : : " + num If nl <> 0 Then cursorpos = bluecursorx : bluecursorupdate = True If moc = False Then we = $803 Case $203 ;- Mouse move mousx = EventX() mousy = EventY() Case $204 ;- Mouse wheel Case $205 ;- Mouse enter If EventSource() = can moc=True End If Case $206 ;- Mouse leave If EventSource() = can moc=False End If Case $401 ;- Gadget action Case $801 ;- Window move SetGadgetShape win,GadgetX(ms)+offset_x,GadgetY(ms)+offset_y,wwidth-width_mod,wheight ; align text window to parent window!! SetGadgetShape can,0,0,wwidth-width_mod,wheight Case $802 ;- Window size Case $803 ;- Window close If EventSource() = ms Then End Case $804 ;- Window activate Case $1001 ;- Menu event Case $2001 ;- App suspend Case $2002 ;- App resume SetGadgetShape win,GadgetX(ms)+offset_x,GadgetY(ms)+offset_y,wwidth-width_mod,wheight ; align text window to parent window!! SetGadgetShape can,0,0,wwidth-width_mod,wheight Case $2003 ;- App Display Change Case $2004 ;- App Begin Modal Case $2005 ;- App End Modal Case $4001 ;- Timer tick SetBuffer CanvasBuffer(can) Cls ; quick hack to fix control handling If KeyDown(29) = True Or KeyDown(157) = True Then ctrlactive = True Else ctrlactive = False; lctrl If KeyDown(42) = True Or KeyDown(54) = True Then shiftactive = True Else shiftactive = False ; lshift ;editline highlight Color r+10,g+10,b+10 ; Set line higlight color Line 0,0,GadgetWidth(can),0 ; draw higlight line Color r,g,b Line 0,GadgetHeight(can)-1,GadgetWidth(can),GadgetHeight(can)-1 Color r-10,g-10,b-10 seldraw = False If selactive = True And sellen <>0 ;And selstart<>cursorpos Then Color sr,sg,sb Rect StringWidth(Left(c$,selstart)),0,StringWidth(Mid$(c$,selstart+1,sellen)),FontHeight() seldraw = True End If blue(num,bluec) = c$ Color fr,fg,fb:bluedrawtext 0,-1,num,can,True ;Color 0,0,0 ;Rect 0,0,30,10,True ;Color fr,fg,fb:Text 0,-1,c$ If cursortimer < MilliSecs() Then cursortimer = MilliSecs() + cursortimerdelay If showcursor = True Then showcursor = False Else showcursor = True End If sellen = selend-selstart selend = cursorpos If selactive=True And sellen = 0 And selreset = False Then ;DebugLog"er" invselactive = False invselstart = cursorpos selend = cursorpos selstart = cursorpos selreset = True ElseIf sellen <> 0 selreset = False End If If sellen < 0 And invselactive = False And selactive = True Then invselactive = True ElseIf invselactive=True And sellen < 0 Then ; hit home with inversed sel;ection invselactive = False selstart = invselstart End If If invselactive = True Then selend = invselstart selstart = cursorpos sellen = invselstart-(cursorpos-1) End If ; drawcursor (yikes!) If showcursor = True Then bluedrawcursor( StringWidth(Left(c$,cursorpos))+(StringWidth(String(" ",bluecursorposx(num)))), FontHeight()-2,StringWidth("a"),blueinsertmode) ; Line 0,220+3,200,220+3 y ; Text 0,220,c_front$ + "|" + c_back ; Text 0,240,"string len : " + Len(c$) ; If selactive = True Then Text 0,250,"sellen : " + sellen + " brr : " + Mid(c$,selstart+1,sellen) ; Text 0,260,"invselactive:" +invselactive+" invselstart:"+invselstart ; Text 0,280,"seldraw:"+seldraw + " selactive:"+selactive ; Text 0,300,"selstart:" + selstart + " cursorpos:" + cursorpos ; Text 0,320,"selend:"+selend+" sellen:"+sellen ; Text 0,340,"ctrlactive:"+ctrlactive FlipCanvas(can) End Select Wend ; store changes blue(num,blueactive) = 0 blue(num,bluec) = c$ blue(num,bluecursortimer) = cursortimer blue(num,bluecursortimerdelay) = cursortimerdelay blue(num,blueshowcursor) = showcursor blue(num,bluecursorpos) = cursorpos blue(num,blueselstart) = selstart blue(num,blueselend) = selend blue(num,blueselactive) = selactive blue(num,blueinvselstart) = invselstart blue(num,blueinvselactive) = invselactive blue(num,blueshiftactive) = shiftactive blue(num,bluectrlactive) = ctrlactive ;blue(num,bluecopybuffer) = copybuffer$ bluelinecopybuffer$ = copybuffer$ ShowGadget backcan FreeGadget can If exitline <-50 Then Return exitline If exitwithcursup = True Then Return exitline If exitwithcursdown = True Then Return exitline If exitwithreturn= True Then Return exitline If mup = True Then Return nl Return -1 End Function Function bluemousecursorupdate() ; core ; Update the cursor with the activities of the mouse pointer ; trigger flag gets inverted! If bluecursorupdate = True Then cursorpos = bluecursorx- (bluelinenumberwidth/FontWidth()) bluecursorupdate = False End If Return cursorpos End Function Function bluereplacelineselection$(in$,repl$,st,nd) ; core a$ = Left(in$,st) b$ = Right(in$,Len(in$)-nd) Return a$+repl$+b$ End Function Function bluedrawcursor(x,y,w,t) ; t = 0 = regular 1 = insert Select t Case 0 ; Regular cursor Color bluecursorcolorr,bluecursorcolorg,bluecursorcolorb Rect x,y-FontHeight(),2,FontHeight(),True Case 1 ; Insert Cursor Color blueinsertcursorcolorr,blueinsertcursorcolorg,blueinsertcursorcolorb Rect x,y,w,2,True End Select End Function Function bluecursorposx(num) ;DebugLog blue(num,bluetabmodifier) Return blue(num,bluetabmodifier) End Function Function movecursorleft(c$,cursorpos) z = instrleft(c$," ",cursorpos) While Mid(c$,z) = " " z=z-1 If z<1 Then Exit Wend Return z-1 End Function Function movecursorright(c$,cursorpos) z = Instr(c$," ",cursorpos) While Mid(c$,z) = " " z=z+1 If z>Len(c$) Then Exit Wend Return z End Function Function instrleft(c$,f$,pos) If f$="" Then Return 0 If Len(c$) = 0 Then Return 0 If pos<0 Or pos>Len(c$) Then Return 0 pos2 = 1 While pos2 <> 0 q = Instr(c$,f$,pos2) ;If Confirm(q+"|"+pos2) Then End If q>pos Then Exit If q = 0 Then Exit pos2 = q+1 Wend Return pos2-1 End Function Function bluerightalign$(in$,tlen) If tlen =<0 Then Return While Len(in$) < tlen in$=" " + in$ : Wend Return in$ End Function Function bluecountchar(num,in$) ; char Input ascii ; ms = MilliSecs() pos = 1 While pos > 0 ; timeout after 2000 millisecs()!!! q = Instr(blue(num,bluec),in$,pos) num2 = num2 + 1 If q = 0 Then Exit pos = q+1 Wend Return num2-1 End Function Function blueloadtext(in$) ; load text If FileType(in$) <> 1 Then RuntimeError in$ cnt = 0 f = ReadFile(in$) ; count lines While Eof(f) = False a$ = ReadLine(f) cnt=cnt + 1 Wend CloseFile(f) bluenumlines = cnt :redimblue(bluenumlines) : cnt = 0 ; redimension blue data array f = ReadFile(in$) ; Load the text (capped at linewidth) While Eof(f) = False And cnt < bluenumlines a$ = Left(ReadLine(f),bluelinewidth) a$ = Replace(a$,Chr(9),String(Chr(32),bluedefaulttabsize)) ;If Asc(a$) = Chr(9) Then a$ = String(Chr(32),bluedefaulttabsize) blue(cnt,bluec) = a$ cnt=cnt+1 Wend CloseFile(f) End Function Function redimblue(num) Dim blue$(num,bluepointers) End Function ; Function bufferlinenumbers() ; make a image that gets blocked into the background of the linenumbers - run after linenumber change Local tempthing = bluelinenumimagebuffer SetBuffer ImageBuffer(tempthing) ra# = bluelinenumberbr ga# = bluelinenumberbg ba# = bluelinenumberbb mod1# = ra/ImageWidth(tempthing) mod2# = ga/ImageWidth(tempthing) mod3# = ba/ImageWidth(tempthing) For x1=0 To ImageWidth(tempthing)-2 Color cnta#,cntb#,cntc# cnta# = cnta + mod1# cntb# = cntb + mod2# cntc# = cntc + mod3# Line x1,0,x1,ImageHeight(tempthing) Next Color cnta#/2,cntb#/2,cntc#/2 Line x1,0,x1,ImageHeight(tempthing) End Function ; Function design_docs() ; ; Tabs are stored as chr code 9. Drawing these on the screen is check by seing if a tab is present in the array hastab flag ; the tabflag bluehastab needs to be cleared in the lines datafield when tabs are removed. ; Currently rethinking if I should use regular spaces and store the tab data seperatly.... ; ; Line numbering is buffered in a image. this has 3 times the height size and only rebuilds when a flag is set ; ; The mouse 2 text cursor x position needs alignment with the text area offset. Line numbering ect. The regular cursor positioning ; is done inside the line edit section. Outside code needs to take this into account seing the line edit uses Zero as it most left ; offset. ; ; End Function Function bluecontrolispressed() If KeyDown(29) Then Return True If KeyDown(157) Then Return True Return False End Function Function loadkeywords() ;load the keywords Local a$ Local kw$[1512] If FileType("keywords.txt") <> 1 Then Notify "can not load" : End ;RuntimeError "Reinstall!!" cnt = 0 f = ReadFile("keywords.txt") ; While Eof(f) = False a$ = ReadLine(f) If Len(a$) > 0 ;k.bluekeywords = New bluekeywords ;k\kw = Lower(a$) kw[cnt] = Lower(a$) cnt=cnt+1 End If Wend ; If cnt = 0 Then RuntimeError "No keywords loaded" ; For i=0 To cnt-1 ; If Instr(kw[i]," ") Then k.bluekeywords = New bluekeywords k\longkw = kw[i] Else k.bluekeywords = New bluekeywords k\shortkw = kw[i] DebugLog kw[i] End If ; Next ; CloseFile(f) Return End Function |
Comments
None.
Code Archives Forum